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 (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=0
  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         exit 104 # Success
  51     elif [ -f finalize-test-failed ]; then
  52         echo "Failed"
  53         exit 1 # Failure
  54     fi
  55     sleep 1
  56     WAITED=$(($WAITED+1))
  57     if (($WAITED>60)); then
  58         echo
  59         echo "timeout, killing SBCL"
  60         kill -9 $SBCL_PID
  61         exit 1 # Failure, SBCL probably hanging in GC
  62     fi
  63 done
  64