tests/finalize-2.impure.lisp

   1 #-sb-thread (invoke-restart 'run-tests::skip-file)
   2
   3 (setq *evaluator-mode* :compile)
   4 ;; example from lp#2029306
   5 (defvar *x*)
   6
   7 (defun clear-registers (&optional a b c d e f g h i j k l m n o p q)
   8   (values q p o n m l k j i h g f e d c b a))
   9
  10 (defun test ()
  11   (setf *x* (make-hash-table))
  12   (clear-registers)
  13   (sb-ext:finalize *x* (lambda () (error "final")) :dont-save t)
  14   (clear-registers)
  15   (sb-sys:scrub-control-stack)
  16   (assert (sb-ext:cancel-finalization *x*)))
  17
  18 (defglobal *runflag* t)
  19 (defvar *thr1*
  20   (sb-thread:make-thread
  21    (lambda ()
  22      (loop while *runflag* do (gc :full t) (sleep 0.01)))
  23    :name "gc"))
  24
  25 (defvar *thr2*
  26   (sb-thread:make-thread
  27    (lambda ()
  28      (let ((*x* nil)) (loop while *runflag* do (test))))
  29    :name "test"))
  30
  31 (test-util:with-test (:name :finalizer-insertion-race)
  32   (sleep 8) ; arbitrary time to let the test run
  33   (setq *runflag* nil)
  34   (mapc 'sb-thread:join-thread (list *thr1* *thr2*)))