common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Split out the slowest tests from gc.impure

Browse source
This commit is contained in:
Douglas Katzman 2019-03-18 11:28:15 -04:00
parent d3de3e1de2
commit 9a506556ec
3 changed files with 36 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
tests/bug-936304.impure.lisp Normal file
View file

@ -0,0 +1,23 @@
(defun stress-gc ()
;; Kludge or not? I don't know whether the smaller allocation size
;; for sb-safepoint is a legitimate correction to the test case, or
;; rather hides the actual bug this test is checking for... It's also
;; not clear to me whether the issue is actually safepoint-specific.
;; But the main problem safepoint-related bugs tend to introduce is a
;; delay in the GC triggering -- and if bug-936304 fails, it also
;; causes bug-981106 to fail, even though there is a full GC in
;; between, which makes it seem unlikely to me that the problem is
;; delay- (and hence safepoint-) related. --DFL
(let* ((x (make-array (truncate #-sb-safepoint (* 0.2 (dynamic-space-size))
#+sb-safepoint (* 0.1 (dynamic-space-size))
sb-vm:n-word-bytes))))
(elt x 0)))
(with-test (:name :bug-936304)
(gc :full t)
(assert (eq :ok (handler-case
(progn
(loop repeat 50 do (stress-gc))
:ok)
(storage-condition ()
:oom)))))

13
tests/bug-981106.impure.lisp Normal file
View file

@ -0,0 +1,13 @@
(with-test (:name :bug-981106)
(gc :full t)
(assert (eq :ok
(handler-case
(dotimes (runs 100 :ok)
(let* ((n (truncate (dynamic-space-size) 1200))
(len (length
(with-output-to-string (string)
(dotimes (i n)
(write-sequence "hi there!" string))))))
(assert (eql len (* n (length "hi there!"))))))
(storage-condition ()
:oom)))))

38
tests/gc.impure.lisp
View file

@ -175,44 +175,6 @@
(assert (= (sb-ext:generation-minimum-age-before-gc i) 0.75))
(assert (= (sb-ext:generation-number-of-gcs-before-promotion i) 1))))
(defun stress-gc ()
;; Kludge or not? I don't know whether the smaller allocation size
;; for sb-safepoint is a legitimate correction to the test case, or
;; rather hides the actual bug this test is checking for... It's also
;; not clear to me whether the issue is actually safepoint-specific.
;; But the main problem safepoint-related bugs tend to introduce is a
;; delay in the GC triggering -- and if bug-936304 fails, it also
;; causes bug-981106 to fail, even though there is a full GC in
;; between, which makes it seem unlikely to me that the problem is
;; delay- (and hence safepoint-) related. --DFL
(let* ((x (make-array (truncate #-sb-safepoint (* 0.2 (dynamic-space-size))
#+sb-safepoint (* 0.1 (dynamic-space-size))
sb-vm:n-word-bytes))))
(elt x 0)))
(with-test (:name :bug-936304)
(gc :full t)
(assert (eq :ok (handler-case
(progn
(loop repeat 50 do (stress-gc))
:ok)
(storage-condition ()
:oom)))))
(with-test (:name :bug-981106)
(gc :full t)
(assert (eq :ok
(handler-case
(dotimes (runs 100 :ok)
(let* ((n (truncate (dynamic-space-size) 1200))
(len (length
(with-output-to-string (string)
(dotimes (i n)
(write-sequence "hi there!" string))))))
(assert (eql len (* n (length "hi there!"))))))
(storage-condition ()
:oom)))))
(with-test (:name :gc-logfile :skipped-on (not :gencgc))
(assert (not (gc-logfile)))
(let ((p (scratch-file-name "log")))