contrib/sb-concurrency/tests/test-utils.lisp

   1 (in-package :sb-concurrency-test)
   2
   3 #+sb-thread
   4 (progn
   5
   6 (defparameter +timeout+ 30.0)
   7
   8 (defun make-threads (n name fn)
   9   (loop for i from 1 to n
  10         collect (make-thread fn :name (format nil "~A-~D" name i))))
  11
  12 (defun timed-join-thread (thread &optional (timeout +timeout+))
  13   (handler-case (sb-sys:with-deadline (:seconds timeout)
  14                   (join-thread thread :default :aborted))
  15     (sb-ext:timeout ()
  16       :timeout)))
  17
  18 (defun hang ()
  19   (join-thread *current-thread*))
  20
  21 (defun kill-thread (thread)
  22   (when (thread-alive-p thread)
  23     (ignore-errors
  24       (terminate-thread thread))))
  25
  26 ) ;; #+sb-thread (progn ...