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