X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fgc.impure.lisp;h=e015ad8efea59195e535dd667613e4234b5f3726;hb=5193965ff7688f7d748962405343ed666bf616b2;hp=e1dd98dc80e34aa5b755c427997bcc54cb6bc6bc;hpb=47eb330ef0f3b99d24c0e24d897b757f16950c4b;p=sbcl.git

diff --git a/tests/gc.impure.lisp b/tests/gc.impure.lisp
index e1dd98d..e015ad8 100644
--- a/tests/gc.impure.lisp
+++ b/tests/gc.impure.lisp
@@ -31,15 +31,7 @@
 (let ((gc-happend nil))
   (push (lambda () (setq gc-happend t)) sb-ext:*after-gc-hooks*)
 
-  ;; check GC-{ON,OFF} works and gc is deferred
-  (gc-off)
-  (gc)
-  (assert (not gc-happend))
-  (gc-on)
-  (assert gc-happend)
-
   ;; check that WITHOUT-GCING defers explicit gc
-  (setq gc-happend nil)
   (sb-sys:without-gcing
     (gc)
     (assert (not gc-happend)))
@@ -58,16 +50,68 @@
       (assert (not gc-happend)))
     ;; give the hook time to run
     (sleep 1)
-    (assert gc-happend))
+    (assert gc-happend)))
 
-  ;; check GC-ON works even in a WITHOUT-GCING
-  (setq gc-happend nil)
-  (sb-sys:without-gcing
-    (gc)
-    (assert (not gc-happend))
-    (gc-on)
-    (assert gc-happend)
-    (setq gc-happend nil))
-  (assert (not gc-happend)))
+;;; SB-EXT:GENERATION-* accessors returned bogus values for generation > 0
+(with-test (:name :bug-529014 :skipped-on '(not :gencgc))
+  (loop for i from 0 to sb-vm:+pseudo-static-generation+
+     do (assert (= (sb-ext:generation-bytes-consed-between-gcs i)
+                   (truncate (sb-ext:bytes-consed-between-gcs)
+                             sb-vm:+highest-normal-generation+)))
+        ;; FIXME: These parameters are a) tunable in the source and b)
+        ;; duplicated multiple times there and now here.  It would be good to
+        ;; OAOO-ify them (probably to src/compiler/generic/params.lisp).
+        (assert (= (sb-ext:generation-minimum-age-before-gc i) 0.75))
+        (assert (= (sb-ext:generation-number-of-gcs-before-promotion i) 1))))
 
-(sb-ext:quit :unix-status 104)
+(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)
+  (time
+   (assert (eq :ok (handler-case
+                       (progn
+                         (loop repeat 50 do (stress-gc))
+                         :ok)
+                     (storage-condition ()
+                       :oom))))))
+
+(with-test (:name :bug-981106)
+  (gc :full t)
+  (time
+   (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)
+  (assert (not (gc-logfile)))
+  (let ((p #p"gc.log"))
+    (assert (not (probe-file p)))
+    (assert (equal p (setf (gc-logfile) p)))
+    (gc)
+    (let ((p2 (gc-logfile)))
+      (assert (equal (truename p2) (truename p))))
+    (assert (not (setf (gc-logfile) nil)))
+    (assert (not (gc-logfile)))
+    (delete-file p)))