* Added a garbage collector stress test.

git-svn-id: svn://svn.zoy.org/elk/trunk@265 55e467fa-43c5-0310-a8a2-de718669efc6

examples/tests/Makefile.am

@@ -1,7 +1,7 @@
 
 CLEANFILES = $(allstamps) mytest.scm tmp1 tmp2 tmp3
 
-allstamps = stamp-r4rs
+allstamps = stamp-r4rs stamp-gc
 
 if NATIVE_BUILD
 all-local: $(allstamps)
@@ -9,11 +9,12 @@ endif
 
 stamp-r4rs: $(top_builddir)/src/elk
 	rm -f $@ mytest.scm
-
 	sed -e 's/r4rstest/mytest/g' < $(srcdir)/r4rstest.scm > mytest.scm
 	echo '(test-cont) (test-sc4) (test-delay)' >> mytest.scm
-
 	-$(top_builddir)/src/elk -p .:$(top_srcdir)/scm -l mytest.scm
 	rm -f mytest.scm tmp1 tmp2 tmp3
 	printf "" > $@
 
+stamp-gc: $(top_builddir)/src/elk
+	-$(top_builddir)/src/elk -p .:$(top_srcdir)/scm -l gc-stress.scm
+

examples/tests/gc-stress.scm

@@ -0,0 +1,33 @@
+
+;; this test sometimes crashes the GC with the well-known
+;; Panic: Visit: object not in prev space at 0x40210b2c ('pair') 8199 8201 (dumping core).
+
+(display "testing garbage collector integrity (1000 loops)\n")
+;(set! garbage-collect-notify? #t)
+(define c 0)
+(define cb
+  (lambda ignore
+    (let ((s '()))
+      (set! c (+ 1 c))
+        (call/cc
+          (lambda (return)
+            (do ((i 0 (+ i 1)))
+                ((= i 100))
+                (let ((a (+ i 1)))
+                  (set! s (append s (list i))))
+                (if (= i 60) (return #t))))))))
+(do ((i 0 (+ i 1))) ((= i 1000)) (cb))
+(display "test passed.\n")
+
+;; This test used to crash the GC, too.
+
+(display "testing deep calls (2000 calls)\n")
+(define crash
+  (lambda (x)
+    (begin
+      (if (> x 0)
+        (crash (- x 1)))
+      (collect))))
+(crash 2000)
+(display "test passed.\n")
+