tests/mutex.impure.lisp

   1 #-sb-thread (invoke-restart 'run-tests::skip-file)
   2
   3 (use-package "SB-THREAD")
   4
   5 ;;; This test takes at least 6 seconds because each thread wants to
   6 ;;; grab and hold the mutex for a total of 3 seconds.
   7 (with-test (:name (:mutex :contention))
   8   (let ((mutex (make-mutex :name "contended")))
   9     (labels ((run ()
  10                (let ((me *current-thread*))
  11                  (dotimes (i 100)
  12                    (with-mutex (mutex)
  13                      (sleep .03)
  14                      (assert (eql (mutex-owner mutex) me)))
  15                    (assert (not (eql (mutex-owner mutex) me))))
  16                  (format t "done ~A~%" *current-thread*))))
  17       (let ((kid1 (make-thread #'run))
  18             (kid2 (make-thread #'run)))
  19         (format t "contention ~A ~A~%" kid1 kid2)
  20         (wait-for-threads (list kid1 kid2))))))
  21
  22 (with-test (:name (interrupt-thread :interrupt-mutex-acquisition)
  23                   :broken-on :win32)
  24   (let ((lock (make-mutex :name "loctite"))
  25         child)
  26     (with-mutex (lock)
  27       (setf child (test-interrupt
  28                    (lambda ()
  29                      (with-mutex (lock)
  30                        (assert (eql (mutex-owner lock) *current-thread*)))
  31                      (assert (not (eql (mutex-owner lock) *current-thread*)))
  32                      (sleep 10))))
  33       ;;hold onto lock for long enough that child can't get it immediately
  34       (sleep 5)
  35       (interrupt-thread child (lambda () (format t "l ~A~%" (mutex-owner lock))))
  36       (format t "parent releasing lock~%"))
  37     (process-all-interrupts child)
  38     (terminate-thread child)
  39     (wait-for-threads (list child))))