X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fgc.impure.lisp;h=e015ad8efea59195e535dd667613e4234b5f3726;hb=9c9d6dbdc28a8bfe70be09f35263e9ec02411d0e;hp=cb9e3e7f7b50f9617439cb9eb850d01d1f3013bc;hpb=661bcd7d3e0bdc1966f3878fa71d322ffd5927a4;p=sbcl.git

diff --git a/tests/gc.impure.lisp b/tests/gc.impure.lisp
index cb9e3e7..e015ad8 100644
--- a/tests/gc.impure.lisp
+++ b/tests/gc.impure.lisp
@@ -65,7 +65,17 @@
         (assert (= (sb-ext:generation-number-of-gcs-before-promotion i) 1))))
 
 (defun stress-gc ()
-  (let* ((x (make-array (truncate (* 0.2 (dynamic-space-size))
+  ;; 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)))
 
@@ -85,10 +95,23 @@
    (assert (eq :ok
                (handler-case
                    (dotimes (runs 100 :ok)
-                     (let ((len (length
-                                 (with-output-to-string (string)
-                                   (dotimes (i 1000000)
-                                     (write-sequence "hi there!" string))))))
-                       (assert (eql len (* 1000000 (length "hi there!"))))))
+                     (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)))