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 echo //entering finalize.test.sh
   8
   9 rm -f finalize-test-passed finalize-test-failed
  10
  11 ${SBCL:-sbcl} <<EOF > /dev/null &
  12 (defvar *tmp* 0.0)
  13 (defvar *count* 0)
  14
  15 (defun foo (_)
  16   (declare (ignore _))
  17   nil)
  18
  19 (let ((junk (mapcar (compile nil '(lambda (_)
  20                                    (declare (ignore _))
  21                                    (let ((x (gensym)))
  22                                      (finalize x (lambda ()
  23                                                    ;; cons in finalizer
  24                                                    (setf *tmp* (make-list 10000))
  25                                                    (incf *count*)))
  26                                      x)))
  27                     (make-list 10000))))
  28     (setf junk (foo junk))
  29     (foo junk))
  30
  31 (gc :full t)
  32 (gc :full t)
  33
  34 (if (= *count* 10000)
  35     (with-open-file (f "finalize-test-passed" :direction :output)
  36       (write-line "OK" f))
  37     (with-open-file (f "finalize-test-failed" :direction :output)
  38       (format f "OOPS: ~A~%" *count*)))
  39
  40 (sb-ext:quit)
  41 EOF
  42
  43 SBCL_PID=$!
  44 WAITED=x
  45
  46 echo "Waiting for SBCL to finish stress-testing finalizers"
  47 while true; do
  48     if [ -f finalize-test-passed ]; then
  49         echo "OK"
  50         rm finalize-test-passed
  51         exit 104 # Success
  52     elif [ -f finalize-test-failed ]; then
  53         echo "Failed"
  54         rm finalize-test-failed
  55         exit 1 # Failure
  56     fi
  57     sleep 1
  58     WAITED="x$WAITED"
  59     if [ $WAITED = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ]; then
  60         echo
  61         echo "timeout, killing SBCL"
  62         kill -9 $SBCL_PID
  63         exit 1 # Failure, SBCL probably hanging in GC
  64     fi
  65 done
  66