This adds tests for the issues mentioned in the preceding. It's independent of the preceding change, and therefore useful for demonstrating why the preceding change is necessary.
Where trivial-timeout is fully working, all tests pass. Where trivial-timeout is minimally working, tests 2-4 pass. Where trivial-timeout is working poorly, tests 3, 4, and 6 fail, except in the case of threadless SBCL, where tests 2, 3, 5, and 6 fail. --- tests/tests.lisp | 53 +++++++++++++++++++++++++++++++++++++----------- 1 file changed, 41 insertions(+), 12 deletions(-)
diff --git a/tests/tests.lisp b/tests/tests.lisp index 6bd39f4..2efa23b 100644 --- a/tests/tests.lisp +++ b/tests/tests.lisp @@ -1,6 +1,6 @@ #|
-these tests are both very unixy +these tests are very unixy
|#
@@ -11,19 +11,48 @@ these tests are both very unixy
(addtest (trivial-timeout-test) test-1 - (multiple-value-bind (result measures condition) - (handler-case - (lift::while-measuring (:measure-seconds) - (with-timeout (0.5) - (sleep 1.0))) - (error (c) - (declare (ignore c)))) - (declare (ignore result)) - (ensure (< (first measures) 0.75) :report "timeout worked") - (ensure (and condition (typep condition 'timeout-error)) - :report "Received timeout error"))) + (let (time) + (measure-time (time) + (ensure-condition (timeout-error :report "did not receive timeout error") + (with-timeout (0.5) + (sleep 1.0)))) + (ensure (< 0.25 time 0.75) :report "timeout failed")))
+(addtest (trivial-timeout-test) + test-2 + (ensure (with-timeout (0.5) t) :report "timeout did not return T")) + +(defparameter *test-var* nil)
+(addtest (trivial-timeout-test) + test-3 + (ensure (let ((*test-var* t)) (with-timeout (0.5) *test-var*)) + :report "dynamic binding failed")) + +(addtest (trivial-timeout-test) + test-4 + (ensure (block nil (with-timeout (0.5) (return t) nil)) + :report "nonlocal exit did work")) + +(addtest (trivial-timeout-test) + test-5 + (let (time) + (measure-time (time) + (ensure-condition (timeout-error :report "did not receive timeout error") + (with-timeout (0.5) + (with-timeout (1.0) + (sleep 1.5))))) + (ensure (< 0.25 time 0.75) :report "timeout failed"))) + +(addtest (trivial-timeout-test) + test-6 + (let (time) + (measure-time (time) + (ensure-condition (timeout-error :report "did not receive timeout error") + (with-timeout (1.5) + (with-timeout (0.5) + (sleep 1.0))))) + (ensure (< 0.25 time 0.75) :report "timeout failed")))
#|