1.0.23.21: Stack allocated conses for MIPS.
[sbcl.git] / tests / finalize.test.sh
1 #!/bin/sh
2 #
3 # This test is as convoluted as it is to avoid having failing tests
4 # hang the test-suite, as the typical failure mode used to be SBCL
5 # hanging uninterruptible in GC.
6
7 . ./subr.sh
8
9 use_test_subdirectory
10
11 echo //entering finalize.test.sh
12
13 run_sbcl <<EOF > /dev/null &
14 (defvar *tmp* 0.0)
15 (defvar *count* 0)
16
17 (defun foo (_)
18   (declare (ignore _))
19   nil)
20
21 (let ((junk (mapcar (compile nil '(lambda (_)
22                                    (declare (ignore _))
23                                    (let ((x (gensym)))
24                                      (finalize x (lambda ()
25                                                    ;; cons in finalizer
26                                                    (setf *tmp* (make-list 10000))
27                                                    (incf *count*)))
28                                      x)))
29                     (make-list 10000))))
30     (setf junk (foo junk))
31     (foo junk))
32
33 (gc :full t)
34 (gc :full t)
35
36 (if (= *count* 10000)
37     (with-open-file (f "finalize-test-passed" :direction :output)
38       (write-line "OK" f))
39     (with-open-file (f "finalize-test-failed" :direction :output)
40       (format f "OOPS: ~A~%" *count*)))
41
42 (sb-ext:quit)
43 EOF
44
45 SBCL_PID=$!
46 WAITED=x
47
48 echo "Waiting for SBCL to finish stress-testing finalizers"
49 while true; do
50     if [ -f finalize-test-passed ]; then
51         echo "OK"
52         rm finalize-test-passed
53         exit $EXIT_TEST_WIN
54     elif [ -f finalize-test-failed ]; then
55         echo "Failed"
56         rm finalize-test-failed
57         exit $EXIT_LOSE
58     fi
59     sleep 1
60     WAITED="x$WAITED"
61     if [ $WAITED = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ]; then
62         echo
63         echo "timeout, killing SBCL"
64         kill -9 $SBCL_PID
65         exit $EXIT_LOSE # Failure, SBCL probably hanging in GC
66     fi
67 done
68