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 (sb-impl::make-timer (lambda () (setq has-run-p t))
  19                             :name "simple timer")))
  20     (sb-impl::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 (sb-impl::make-timer (lambda () (setq has-run-p t))
  30                             :name "simple timer")))
  31     (sb-impl::schedule-timer timer (+ 1/2 (get-universal-time))
  32                              :absolute-p t)
  33     (sleep 0.2)
  34     (assert (not has-run-p))
  35     (sleep 0.5)
  36     (assert has-run-p)
  37     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
  38
  39 (defvar *x* nil)
  40
  41 #+sb-thread
  42 (with-test (:name (:timer :other-thread))
  43   (let* ((thread (sb-thread:make-thread (lambda () (let ((*x* t)) (sleep 2)))))
  44          (timer (sb-impl::make-timer (lambda () (assert *x*)) :thread thread)))
  45     (sb-impl::schedule-timer timer 0.1)))
  46
  47 #+sb-thread
  48 (with-test (:name (:timer :new-thread))
  49   (let ((*x* t)
  50         (timer (sb-impl::make-timer (lambda () (assert (not *x*))) :thread t)))
  51     (sb-impl::schedule-timer timer 0.1)))
  52
  53 (with-test (:name (:timer :repeat-and-unschedule))
  54   (let* ((run-count 0)
  55          timer)
  56     (setq timer
  57           (sb-impl::make-timer (lambda ()
  58                         (when (= 5 (incf run-count))
  59                           (sb-impl::unschedule-timer timer)))))
  60     (sb-impl::schedule-timer timer 0 :repeat-interval 0.2)
  61     (assert (not (sb-impl::timer-expired-p timer 0.3)))
  62     (sleep 1.3)
  63     (assert (= 5 run-count))
  64     (assert (sb-impl::timer-expired-p timer))
  65     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
  66
  67 (with-test (:name (:timer :reschedule))
  68   (let* ((has-run-p nil)
  69          (timer (sb-impl::make-timer (lambda ()
  70                               (setq has-run-p t)))))
  71     (sb-impl::schedule-timer timer 0.2)
  72     (sb-impl::schedule-timer timer 0.3)
  73     (sleep 0.5)
  74     (assert has-run-p)
  75     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
  76
  77 (with-test (:name (:timer :stress))
  78   (let ((time (1+ (get-universal-time))))
  79     (loop repeat 200 do
  80           (sb-impl::schedule-timer (sb-impl::make-timer (lambda ())) time
  81                                    :absolute-p t))
  82     (sleep 2)
  83     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
  84
  85 (defmacro raises-timeout-p (&body body)
  86   `(handler-case (progn (progn ,@body) nil)
  87     (sb-ext:timeout () t)))
  88
  89 (with-test (:name (:with-timeout :timeout))
  90   (assert (raises-timeout-p
  91            (sb-ext:with-timeout 0.2
  92              (sleep 1)))))
  93
  94 (with-test (:name (:with-timeout :fall-through))
  95   (assert (not (raises-timeout-p
  96                 (sb-ext:with-timeout 0.3
  97                   (sleep 0.1))))))
  98
  99 (with-test (:name (:with-timeout :nested-timeout-smaller))
 100   (assert(raises-timeout-p
 101           (sb-ext:with-timeout 10
 102             (sb-ext:with-timeout 0.5
 103               (sleep 2))))))
 104
 105 (with-test (:name (:with-timeout :nested-timeout-bigger))
 106   (assert(raises-timeout-p
 107           (sb-ext:with-timeout 0.5
 108             (sb-ext:with-timeout 2
 109               (sleep 2))))))