tests/gc-slow.impure.lisp

   1 (defparameter *x* ())
   2
   3 (defun cons-madly ()
   4   (loop repeat 10000 do
   5         (setq *x* (make-string 100000))))
   6
   7 ;; check that WITHOUT-INTERRUPTS doesn't block the gc trigger
   8 (with-test (:name :cons-madly-without-interrupts)
   9   (sb-sys:without-interrupts (cons-madly)))
  10
  11 (with-test (:name :without-gcing)
  12   (let ((gc-happend nil))
  13     (push (lambda () (setq gc-happend t)) sb-ext:*after-gc-hooks*)
  14
  15     ;; check that WITHOUT-GCING defers explicit gc
  16     (sb-sys:without-gcing
  17       (gc)
  18       (assert (not gc-happend)))
  19     (assert gc-happend)
  20
  21     ;; check that WITHOUT-GCING defers SIG_STOP_FOR_GC
  22     #+sb-thread
  23     (let ((in-without-gcing nil))
  24       (setq gc-happend nil)
  25       (sb-thread:make-thread (lambda ()
  26                                (loop while (not in-without-gcing))
  27                                (sb-ext:gc)))
  28       (sb-sys:without-gcing
  29         (setq in-without-gcing t)
  30         (sleep 3)
  31         (assert (not gc-happend)))
  32       ;; give the hook time to run
  33       (sleep 1)
  34       (assert gc-happend))))
  35
  36 ;;; After each iteration of FOO there are a few pinned conses.
  37 ;;; On alternate GC cycles, those get promoted to generation 1.
  38 ;;; When the logic for page-spanning-object zeroing incorrectly decreased
  39 ;;; the upper bound on bytes used for partially pinned pages, it caused
  40 ;;; an accumulation of pages in generation 1 each with 2 objects' worth
  41 ;;; of bytes, and the remainder waste. Because the waste was not accounted
  42 ;;; for, it did not trigger GC enough to avoid heap exhaustion.
  43 (with-test (:name :smallobj-auto-gc-trigger)
  44   ;; Ensure that these are compiled functions because the interpreter
  45   ;; would make lots of objects of various sizes which is insufficient
  46   ;; to provoke the bug.
  47   (setf (symbol-function 'foo)
  48         (compile nil '(lambda () (list 1 2))))
  49   ;; 500 million iterations of this loop seems to be reliable enough
  50   ;; to show that GC happens.
  51   (setf (symbol-function 'callfoo)
  52         (compile nil '(lambda () (loop repeat 500000000 do (foo)))))
  53   (funcall 'callfoo))
  54
  55 #+sb-thread
  56 (with-test (:name :concurrently-alloc-code)
  57   ;; this debug setting may or may not find a problem, but it can't hurt to try
  58   (setf (extern-alien "pre_verify_gen_0" int) 1)
  59   (let ((worker-th
  60          (sb-thread:make-thread
  61           (let ((stop (+ (get-internal-real-time)
  62                          (* 1.5 internal-time-units-per-second))))
  63             (lambda (&aux (n 0))
  64               (loop while (<= (get-internal-real-time) stop)
  65                     do (compile nil `(lambda () (print 20)))
  66                        (incf n))
  67               n)))))
  68     (let ((gcs 0))
  69       (loop (gc) (incf gcs)
  70             (unless (sb-thread:thread-alive-p worker-th)
  71               (return))
  72             (sb-unix:nanosleep 0 (+ 1000000 (random 100000))))
  73       (let ((compiles (sb-thread:join-thread worker-th)))
  74         (format t "~&Compiled ~D times, GC'ed ~D times~%"
  75                 compiles gcs))))
  76   (setf (extern-alien "pre_verify_gen_0" int) 0))