Update of /cvsroot/sbcl/sbcl/tests
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv14360/tests
Modified Files:
deadline.impure.lisp
Log Message:
1.0.37.6: Add SB-SYS:CANCEL-DEADLINE restart to DEADLINE-TIMEOUTs.
* Establish an SB-SYS:CANCEL-DEADLINE restart in SIGNAL-DEADLINE.
* Add an SB-SYS:CANCEL-DEADLINE restart function.
* Make SB-INT:READ-EVALUATED-FORM take an optional prompt. This
function is commonly used to query the user for input in restarts.
Use it in the SB-SYS:DEFER-DEADLINE restart in SIGNAL-DEADLINE.
* Bind *DEADLINE-SECONDS* in SB-THREAD:MAKE-THREAD. Not binding it
does not seem to have severe consequences, but that's not obvious
so just bind both so humans won't waste brain cycles on
it. SB-KERNEL:SUB-GC also binds both.
* Add usage of WITH-TEST to tests/deadline.impure.lisp. Also add
a test case for the new CANCEL-DEADLINE restart.
Index: deadline.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/deadline.impure.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- deadline.impure.lisp 16 Feb 2009 22:17:56 -0000 1.4
+++ deadline.impure.lisp 28 Mar 2010 17:35:37 -0000 1.5
@@ -1,3 +1,7 @@
+(in-package :cl-user)
+
+(use-package :test-util)
+
(defmacro assert-timeout (form)
(let ((ok (gensym "OK")))
`(let ((,ok ',ok))
@@ -7,60 +11,86 @@
,ok)))
(error "No timeout from form:~% ~S" ',form)))))
+(defun run-sleep (seconds)
+ (sb-ext:run-program "sleep" (list (format nil "~D" seconds))
+ :search t :wait t))
-(assert-timeout
- (sb-sys:with-deadline (:seconds 1)
- (run-program "sleep" '("3") :search t :wait t)))
+(with-test (:name (:deadline :run-program :trivial))
+ (assert-timeout (sb-sys:with-deadline (:seconds 1)
+ (run-sleep 3))))
-(let ((n 0)
- (final nil))
- (handler-case
- (handler-bind ((sb-sys:deadline-timeout (lambda (c)
- (when (< n 2)
- (incf n)
- (sb-sys:defer-deadline 0.1 c)))))
- (sb-sys:with-deadline (:seconds 1)
- (run-program "sleep" '("2") :search t :wait t)))
- (sb-sys:deadline-timeout (c)
- (setf final c)))
- (assert (= n 2))
- (assert final))
+(with-test (:name (:deadline :defer-deadline-1))
+ (let ((n 0)
+ (final nil))
+ (handler-case
+ (handler-bind ((sb-sys:deadline-timeout
+ #'(lambda (c)
+ (when (< n 2)
+ (incf n)
+ (sb-sys:defer-deadline 0.1 c)))))
+ (sb-sys:with-deadline (:seconds 1)
+ (run-sleep 2)))
+ (sb-sys:deadline-timeout (c)
+ (setf final c)))
+ (assert (= n 2))
+ (assert final)))
-(let ((n 0)
- (final nil))
- (handler-case
- (handler-bind ((sb-sys:deadline-timeout (lambda (c)
- (incf n)
- (sb-sys:defer-deadline 0.1 c))))
- (sb-sys:with-deadline (:seconds 1)
- (run-program "sleep" '("2") :search t :wait t)))
- (sb-sys:deadline-timeout (c)
- (setf final c)))
- (assert (plusp n))
- (assert (not final)))
+(with-test (:name (:deadline :defer-deadline-2))
+ (let ((n 0)
+ (final nil))
+ (handler-case
+ (handler-bind ((sb-sys:deadline-timeout
+ #'(lambda (c)
+ (incf n)
+ (sb-sys:defer-deadline 0.1 c))))
+ (sb-sys:with-deadline (:seconds 1)
+ (run-sleep 2)))
+ (sb-sys:deadline-timeout (c)
+ (setf final c)))
+ (assert (plusp n))
+ (assert (not final))))
+
+(with-test (:name (:deadline :cancel-deadline))
+ (let ((n 0)
+ (final nil))
+ (handler-case
+ (handler-bind ((sb-sys:deadline-timeout
+ #'(lambda (c)
+ (incf n)
+ (sb-sys:cancel-deadline c))))
+ (sb-sys:with-deadline (:seconds 1)
+ (run-sleep 2)))
+ (sb-sys:deadline-timeout (c)
+ (setf final c)))
+ (assert (= n 1))
+ (assert (not final))))
#+(and sb-thread (not sb-lutex))
(progn
- (assert-timeout
- (let ((lock (sb-thread:make-mutex))
- (waitp t))
- (sb-thread:make-thread (lambda ()
- (sb-thread:get-mutex lock)
- (setf waitp nil)
- (sleep 5)))
- (loop while waitp do (sleep 0.01))
- (sb-impl::with-deadline (:seconds 1)
- (sb-thread:get-mutex lock))))
- (assert-timeout
- (let ((sem (sb-thread::make-semaphore :count 0)))
- (sb-impl::with-deadline (:seconds 1)
- (sb-thread::wait-on-semaphore sem))))
+ (with-test (:name (:deadline :get-mutex))
+ (assert-timeout
+ (let ((lock (sb-thread:make-mutex))
+ (waitp t))
+ (sb-thread:make-thread (lambda ()
+ (sb-thread:get-mutex lock)
+ (setf waitp nil)
+ (sleep 5)))
+ (loop while waitp do (sleep 0.01))
+ (sb-sys:with-deadline (:seconds 1)
+ (sb-thread:get-mutex lock)))))
- (assert-timeout
- (sb-impl::with-deadline (:seconds 1)
- (sb-thread:join-thread
- (sb-thread:make-thread (lambda () (loop (sleep 1)))))))
+ (with-test (:name (:deadline :wait-on-semaphore))
+ (assert-timeout
+ (let ((sem (sb-thread::make-semaphore :count 0)))
+ (sb-sys:with-deadline (:seconds 1)
+ (sb-thread::wait-on-semaphore sem)))))
+
+ (with-test (:name (:deadline :join-thread))
+ (assert-timeout
+ (sb-sys:with-deadline (:seconds 1)
+ (sb-thread:join-thread
+ (sb-thread:make-thread (lambda () (loop (sleep 1))))))))
(with-test (:name (:deadline :futex-wait-eintr))
(let ((lock (sb-thread:make-mutex))
@@ -74,7 +104,7 @@
(lambda ()
(let ((start (get-internal-real-time)))
(handler-case
- (sb-impl::with-deadline (:seconds 1)
+ (sb-sys:with-deadline (:seconds 1)
(sb-thread:get-mutex lock))
(sb-sys:deadline-timeout (x)
(declare (ignore x))
@@ -86,4 +116,4 @@
(sb-thread:interrupt-thread thread (lambda () 42))
(let ((seconds-passed (sb-thread:join-thread thread)))
(format t "Deadline in ~S~%" seconds-passed)
- (assert (< seconds-passed 1.2)))))))
+ (assert (< seconds-passed 1.2)))))))
\ No newline at end of file
|