X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffinalize.test.sh;h=e2ef1bcbe9251d62d3b6bb67bcf1a6128e722e54;hb=b76dac3d5f89700f3a076403157eae3c52e4c118;hp=3ba4997d7b389ff23df6962d99257b2a3b5b4e22;hpb=04d819bb1a2e64de4e997203b9516229bb73c686;p=sbcl.git diff --git a/tests/finalize.test.sh b/tests/finalize.test.sh index 3ba4997..e2ef1bc 100644 --- a/tests/finalize.test.sh +++ b/tests/finalize.test.sh @@ -4,11 +4,13 @@ # hang the test-suite, as the typical failure mode used to be SBCL # hanging uninterruptible in GC. -echo //entering finalize.test.sh +. ./subr.sh + +use_test_subdirectory -rm -f finalize-test-passed finalize-test-failed +echo //entering finalize.test.sh -${SBCL:-sbcl} < /dev/null & +run_sbcl < /dev/null & (defvar *tmp* 0.0) (defvar *count* 0) @@ -16,15 +18,15 @@ ${SBCL:-sbcl} < /dev/null & (declare (ignore _)) nil) -(let ((junk (mapcar (lambda (_) - (declare (ignore _)) - (let ((x (gensym))) - (finalize x (lambda () - ;; cons in finalizer - (setf *tmp* (make-list 10000)) - (incf *count*))) - x)) - (make-list 10000)))) +(let ((junk (mapcar (compile nil '(lambda (_) + (declare (ignore _)) + (let ((x (gensym))) + (finalize x (lambda () + ;; cons in finalizer + (setf *tmp* (make-list 10000)) + (incf *count*))) + x))) + (make-list 10000)))) (setf junk (foo junk)) (foo junk)) @@ -41,26 +43,26 @@ ${SBCL:-sbcl} < /dev/null & EOF SBCL_PID=$! -WAITED=0 +WAITED=x echo "Waiting for SBCL to finish stress-testing finalizers" while true; do if [ -f finalize-test-passed ]; then echo "OK" rm finalize-test-passed - exit 104 # Success + exit $EXIT_TEST_WIN elif [ -f finalize-test-failed ]; then echo "Failed" rm finalize-test-failed - exit 1 # Failure + exit $EXIT_LOSE fi sleep 1 - WAITED=$(($WAITED+1)) - if (($WAITED>60)); then + WAITED="x$WAITED" + if [ $WAITED = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ]; then echo echo "timeout, killing SBCL" kill -9 $SBCL_PID - exit 1 # Failure, SBCL probably hanging in GC + exit $EXIT_LOSE # Failure, SBCL probably hanging in GC fi done