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 ;; Stopping the finalizer thread ensures that queued finalizers execute.
  37 ;; [I don't think it's possible for it to stop before draining the queue,
  38 ;; but that isn't part of the contract with stopping. If this test fails,
  39 ;; try inserting a call to RUN-PENDING-FINALIZERS after this line]
  40 #+sb-thread (sb-impl::finalizer-thread-stop)
  41
  42 (if (= *count* 10000)
  43     (with-open-file (f "finalize-test-passed" :direction :output)
  44       (write-line "OK" f))
  45     (with-open-file (f "finalize-test-failed" :direction :output)
  46       (format f "OOPS: ~A~%" *count*)))
  47
  48 (sb-ext:quit)
  49 EOF
  50
  51 SBCL_PID=$!
  52 WAITED=x
  53
  54 echo "Waiting for SBCL to finish stress-testing finalizers"
  55 while true; do
  56     if [ -f finalize-test-passed ]; then
  57         echo "OK"
  58         rm finalize-test-passed
  59         exit $EXIT_TEST_WIN
  60     elif [ -f finalize-test-failed ]; then
  61         echo "Failed"
  62         rm finalize-test-failed
  63         exit $EXIT_LOSE
  64     fi
  65     sleep 1
  66     WAITED="x$WAITED"
  67     if [ $WAITED = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ]; then
  68         echo
  69         echo "timeout, killing SBCL"
  70         kill -9 $SBCL_PID
  71         exit $EXIT_LOSE # Failure, SBCL probably hanging in GC
  72     fi
  73 done
  74