tests/gc-threads.impure.lisp

   1 #-sb-thread (invoke-restart 'run-tests::skip-file)
   2
   3 (with-test (:name (:two-threads-running-gc)
   4                   :broken-on :sb-safepoint)
   5   (let (a-done b-done)
   6     (make-join-thread (lambda ()
   7                         (dotimes (i 100)
   8                           (sb-ext:gc) (princ "\\") (force-output))
   9                         (setf a-done t)))
  10     (make-join-thread (lambda ()
  11                         (dotimes (i 25)
  12                           (sb-ext:gc :full t)
  13                           (princ "/") (force-output))
  14                         (setf b-done t)))
  15     (loop
  16       (when (and a-done b-done) (return))
  17       (sleep 1))))
  18
  19 (defun waste (&optional (n 1000))
  20   (loop repeat n do (test-util:opaque-identity (make-string 16384))))
  21
  22 (compile 'waste)
  23
  24 (with-test (:name (:one-thread-runs-gc-while-other-conses)
  25                   :broken-on :win32)
  26   (loop for i below 100 do
  27         (princ "!")
  28         (force-output)
  29         (make-join-thread
  30          #'(lambda ()
  31              (waste)))
  32         (waste)
  33         (sb-ext:gc)))
  34
  35 (defparameter *aaa* nil)
  36 (with-test (:name (:one-thread-runs-gc-while-other-conses :again)
  37             :broken-on :win32)
  38   (loop for i below 100 do
  39         (princ "!")
  40         (force-output)
  41         (make-join-thread
  42          #'(lambda ()
  43              (let ((*aaa* (waste)))
  44                (waste))))
  45         (let ((*aaa* (waste)))
  46           (waste))
  47         (sb-ext:gc)))