tests/interrupt-atomic-incf.impure.lisp

   1 #-sb-thread (invoke-restart 'run-tests::skip-file)
   2
   3 (use-package "SB-THREAD")
   4
   5 (defstruct counter (n 0 :type sb-vm:word))
   6 (defvar *interrupt-counter* (make-counter))
   7
   8 (declaim (notinline check-interrupt-count))
   9 (defun check-interrupt-count (i)
  10   (declare (optimize (debug 1) (speed 1)))
  11   ;; This used to lose if eflags were not restored after an interrupt.
  12   (unless (typep i 'fixnum)
  13     (error "!!!!!!!!!!!")))
  14
  15 (with-test (:name (interrupt-thread :interrupt-ATOMIC-INCF)
  16                   :broken-on :win32)
  17   (let ((c (make-thread
  18             (lambda ()
  19               (handler-bind ((error #'(lambda (cond)
  20                                         (princ cond)
  21                                         (sb-debug:print-backtrace
  22                                          :count most-positive-fixnum))))
  23                 (loop (check-interrupt-count
  24                        (counter-n *interrupt-counter*))))))))
  25     (let ((func (lambda ()
  26                   (princ ".")
  27                   (force-output)
  28                   (sb-ext:atomic-incf (counter-n *interrupt-counter*)))))
  29       (setf (counter-n *interrupt-counter*) 0)
  30       (dotimes (i 100)
  31         (sleep (random 0.1d0))
  32         (interrupt-thread c func))
  33       (loop until (= (counter-n *interrupt-counter*) 100) do (sleep 0.1))
  34       (terminate-thread c)
  35       (wait-for-threads (list c)))))