tests/interrupt-consing.impure.lisp

   1 #-sb-thread (invoke-restart 'run-tests::skip-file)
   2
   3 (use-package "SB-THREAD")
   4
   5 (defun alloc-stuff () (copy-list '(1 2 3 4 5)))
   6
   7 (with-test (:name (:interrupt-thread :interrupt-consing-child)
   8                   :broken-on :win32)
   9   (let* ((thread (make-thread (lambda () (loop (alloc-stuff)))))
  10          (killer (make-thread
  11                   (lambda ()
  12                     (loop repeat 100 do
  13                           (sleep (random 0.1d0))
  14                           (princ ".")
  15                           (force-output)
  16                           (process-all-interrupts thread)
  17                           (interrupt-thread thread (lambda ())))))))
  18     (wait-for-threads (list killer))
  19     (process-all-interrupts thread)
  20     (terminate-thread thread)
  21     (wait-for-threads (list thread)))
  22   (sb-ext:gc :full t))
  23
  24 #+(or x86 x86-64) ;; x86oid-only, see internal commentary.
  25 (with-test (:name (:interrupt-thread :interrupt-consing-child :again)
  26                   :broken-on :win32)
  27   (let ((c (make-thread (lambda () (loop (alloc-stuff))))))
  28     ;; NB this only works on x86: other ports don't have a symbol for
  29     ;; pseudo-atomic atomicity
  30     (dotimes (i 100)
  31       (sleep (random 0.1d0))
  32       (process-all-interrupts c)
  33       (interrupt-thread c
  34                         (lambda ()
  35                           (princ ".")
  36                           (force-output)
  37                           (assert (thread-alive-p *current-thread*))
  38                           (assert
  39                            (not (logbitp 0 SB-KERNEL:*PSEUDO-ATOMIC-BITS*))))))
  40     (process-all-interrupts c)
  41     (terminate-thread c)
  42     (wait-for-threads (list c))))