Really restore clisp cross-compilation.
[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 # $! 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)
17
18 (defun foo (_)
19   (declare (ignore _))
20   nil)
21
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))
33
34 (gc :full t)
35 (gc :full t)
36
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*)))
42
43 (sb-ext:quit)
44 EOF
45
46 SBCL_PID=$!
47 WAITED=x
48
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
59     fi
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
67     fi
68 done
69