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