X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fgc.impure.lisp;h=ef4313af3ee7675540e14622758591aa39f4747a;hb=d720bc359f03734ccb9baf66cb45dc01d623f369;hp=a5e9bfb82c6b9426ea511bff584e9baae615f31a;hpb=4c81c652cdc32faefee1bccb84c3c9a7854e3edd;p=sbcl.git

diff --git a/tests/gc.impure.lisp b/tests/gc.impure.lisp
index a5e9bfb..ef4313a 100644
--- a/tests/gc.impure.lisp
+++ b/tests/gc.impure.lisp
@@ -54,10 +54,42 @@
 
 ;;; SB-EXT:GENERATION-* accessors returned bogus values for generation > 0
 (with-test (:name :bug-529014 :skipped-on '(not :gencgc))
-  ;; 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).
   (loop for i from 0 to sb-vm:+pseudo-static-generation+
-     do (assert (= (sb-ext:generation-bytes-consed-between-gcs i) 2000000))
-       (assert (= (sb-ext:generation-minimum-age-before-gc i) 0.75))
-       (assert (= (sb-ext:generation-number-of-gcs-before-promotion i) 1))))
+     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))))
+
+(defun stress-gc ()
+  (let* ((x (make-array (truncate (* 0.2 (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))))))