diff --git a/examples/tests/Makefile.am b/examples/tests/Makefile.am index b3fdd19..62de38d 100644 --- a/examples/tests/Makefile.am +++ b/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 + diff --git a/examples/tests/gc-stress.scm b/examples/tests/gc-stress.scm new file mode 100644 index 0000000..4492ee5 --- /dev/null +++ b/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") +