X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fthreads.pure.lisp;h=0816e51ec389c576fe5f841d317ae69f94de6f9d;hb=d6f9676ae94419cb5544c45821a8d31adbc1fbe8;hp=ce0df2d9261d33c92f3d80e8242f609c978fe4f5;hpb=0a3d799b59df15a7fcd680182f88feda8704f261;p=sbcl.git diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp index ce0df2d..0816e51 100644 --- a/tests/threads.pure.lisp +++ b/tests/threads.pure.lisp @@ -52,7 +52,6 @@ ;;; Condition-wait should not be interruptible under WITHOUT-INTERRUPTS (with-test (:name without-interrupts+condition-wait - :fails-on :sb-lutex :skipped-on '(not :sb-thread)) (let* ((lock (make-mutex)) (queue (make-waitqueue)) @@ -191,7 +190,9 @@ ;;; wich _appear_ to be caused by malloc() and free() not being thread safe: an ;;; interrupted malloc in one thread can apparently block a free in another. There ;;; are also some indications that pthread_mutex_lock is not re-entrant. -(with-test (:name symbol-value-in-thread.3 :skipped-on '(not :sb-thread) :broken-on :darwin) +(with-test (:name symbol-value-in-thread.3 + :skipped-on '(not :sb-thread) + :broken-on :darwin) (let* ((parent *current-thread*) (semaphore (make-semaphore)) (running t) @@ -372,10 +373,8 @@ :ok))) :name "T1"))) ;; Currently we don't consider it a deadlock - ;; if there is a timeout in the chain. No - ;; Timeouts on lutex builds, though. - (assert (eq #-sb-lutex :deadline - #+sb-lutex :deadlock + ;; if there is a timeout in the chain. + (assert (eq :deadline (handler-case (sb-thread:with-mutex (m2) (sb-thread:signal-semaphore s2) @@ -506,3 +505,22 @@ (join-thread value)) (assert (and (null value) error)))) + +(with-test (:name (:wait-for :basics)) + (assert (not (sb-ext:wait-for nil :timeout 0.1))) + (assert (eql 42 (sb-ext:wait-for 42))) + (let ((n 0)) + (assert (eql 100 (sb-ext:wait-for (when (= 100 (incf n)) + n)))))) + +(with-test (:name (:wait-for :deadline)) + (assert (eq :ok + (sb-sys:with-deadline (:seconds 10) + (assert (not (sb-ext:wait-for nil :timeout 0.1))) + :ok))) + (assert (eq :deadline + (handler-case + (sb-sys:with-deadline (:seconds 0.1) + (sb-ext:wait-for nil :timeout 10) + (error "oops")) + (sb-sys:deadline-timeout () :deadline)))))