1.0.27.46: Fix build on systems with "src" in the path.
[sbcl/tcr.git] / tests / finalize.test.sh
blobded7232df4cdb9b9880a1e7a6602dba467773fd0
1 #!/bin/sh
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.
7 . ./subr.sh
9 use_test_subdirectory
11 echo //entering finalize.test.sh
13 # $! is not set correctly when calling run_sbcl, do it directly
14 "$SBCL_RUNTIME" --core "$SBCL_CORE" $SBCL_ARGS <<EOF > /dev/null &
15 (defvar *tmp* 0.0)
16 (defvar *count* 0)
18 (defun foo (_)
19 (declare (ignore _))
20 nil)
22 (let ((junk (mapcar (compile nil '(lambda (_)
23 (declare (ignore _))
24 (let ((x (gensym)))
25 (finalize x (lambda ()
26 ;; cons in finalizer
27 (setf *tmp* (make-list 10000))
28 (incf *count*)))
29 x)))
30 (make-list 10000))))
31 (setf junk (foo junk))
32 (foo junk))
34 (gc :full t)
35 (gc :full t)
37 (if (= *count* 10000)
38 (with-open-file (f "finalize-test-passed" :direction :output)
39 (write-line "OK" f))
40 (with-open-file (f "finalize-test-failed" :direction :output)
41 (format f "OOPS: ~A~%" *count*)))
43 (sb-ext:quit)
44 EOF
46 SBCL_PID=$!
47 WAITED=x
49 echo "Waiting for SBCL to finish stress-testing finalizers"
50 while true; do
51 if [ -f finalize-test-passed ]; then
52 echo "OK"
53 rm finalize-test-passed
54 exit $EXIT_TEST_WIN
55 elif [ -f finalize-test-failed ]; then
56 echo "Failed"
57 rm finalize-test-failed
58 exit $EXIT_LOSE
60 sleep 1
61 WAITED="x$WAITED"
62 if [ $WAITED = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ]; then
63 echo
64 echo "timeout, killing SBCL"
65 kill -9 $SBCL_PID
66 exit $EXIT_LOSE # Failure, SBCL probably hanging in GC
68 done