projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.9.5.78:
[sbcl.git]
/
tests
/
threads.impure.lisp
diff --git
a/tests/threads.impure.lisp
b/tests/threads.impure.lisp
index
f9bec10
..
bc56053
100644
(file)
--- a/
tests/threads.impure.lisp
+++ b/
tests/threads.impure.lisp
@@
-99,8
+99,7
@@
(assert (eql (mutex-value l) nil) nil "5"))
(labels ((ours-p (value)
(assert (eql (mutex-value l) nil) nil "5"))
(labels ((ours-p (value)
- (sb-vm:control-stack-pointer-valid-p
- (sb-sys:int-sap (sb-kernel:get-lisp-obj-address value)))))
+ (eq *current-thread* value)))
(let ((l (make-mutex :name "rec")))
(assert (eql (mutex-value l) nil) nil "1")
(sb-thread:with-recursive-lock (l)
(let ((l (make-mutex :name "rec")))
(assert (eql (mutex-value l) nil) nil "1")
(sb-thread:with-recursive-lock (l)
@@
-110,6
+109,11
@@
(assert (ours-p (mutex-value l)) nil "5"))
(assert (eql (mutex-value l) nil) nil "6")))
(assert (ours-p (mutex-value l)) nil "5"))
(assert (eql (mutex-value l) nil) nil "6")))
+(with-test (:name (:mutex :nesting-mutex-and-recursive-lock))
+ (let ((l (make-mutex :name "a mutex")))
+ (with-mutex (l)
+ (with-recursive-lock (l)))))
+
(let ((l (make-spinlock :name "spinlock"))
(p *current-thread*))
(assert (eql (spinlock-value l) 0) nil "1")
(let ((l (make-spinlock :name "spinlock"))
(p *current-thread*))
(assert (eql (spinlock-value l) 0) nil "1")
@@
-151,8
+155,7
@@
(let ((queue (make-waitqueue :name "queue"))
(lock (make-mutex :name "lock")))
(labels ((ours-p (value)
(let ((queue (make-waitqueue :name "queue"))
(lock (make-mutex :name "lock")))
(labels ((ours-p (value)
- (sb-vm:control-stack-pointer-valid-p
- (sb-sys:int-sap (sb-kernel:get-lisp-obj-address value))))
+ (eq *current-thread* value))
(in-new-thread ()
(with-recursive-lock (lock)
(assert (ours-p (mutex-value lock)))
(in-new-thread ()
(with-recursive-lock (lock)
(assert (ours-p (mutex-value lock)))
@@
-176,7
+179,7
@@
(let ((me *current-thread*))
(dotimes (i 100)
(with-mutex (mutex)
(let ((me *current-thread*))
(dotimes (i 100)
(with-mutex (mutex)
- (sleep .1)
+ (sleep .03)
(assert (eql (mutex-value mutex) me)))
(assert (not (eql (mutex-value mutex) me))))
(format t "done ~A~%" *current-thread*))))
(assert (eql (mutex-value mutex) me)))
(assert (not (eql (mutex-value mutex) me))))
(format t "done ~A~%" *current-thread*))))
@@
-313,7
+316,7
@@
(interrupt-thread c
(lambda ()
(princ ".") (force-output)
(interrupt-thread c
(lambda ()
(princ ".") (force-output)
- (assert (eq (thread-state *current-thread*) :running))
+ (assert (thread-alive-p *current-thread*))
(assert (zerop SB-KERNEL:*PSEUDO-ATOMIC-ATOMIC*)))))
(terminate-thread c)
(wait-for-threads (list c)))
(assert (zerop SB-KERNEL:*PSEUDO-ATOMIC-ATOMIC*)))))
(terminate-thread c)
(wait-for-threads (list c)))
@@
-460,23
+463,13
@@
(format t "~&session lock test done~%")
(format t "~&session lock test done~%")
-(sb-ext:gc :full t)
(loop repeat 20 do
(wait-for-threads
(loop for i below 100 collect
(loop repeat 20 do
(wait-for-threads
(loop for i below 100 collect
- (sb-thread:make-thread (lambda ()))))
- (sb-ext:gc :full t)
- (princ "+")
- (force-output))
+ (sb-thread:make-thread (lambda ())))))
(format t "~&creation test done~%")
(format t "~&creation test done~%")
-;; watch out for *current-thread* being the parent thread after exit
-(let ((thread (sb-thread:make-thread (lambda ()))))
- (wait-for-threads (list thread))
- (assert (null (symbol-value-in-thread 'sb-thread:*current-thread*
- thread))))
-
;; interrupt handlers are per-thread with pthreads, make sure the
;; handler installed in one thread is global
(sb-thread:make-thread
;; interrupt handlers are per-thread with pthreads, make sure the
;; handler installed in one thread is global
(sb-thread:make-thread