X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fthreads.impure.lisp;h=bc56053bdbae5e501123d4e115eb92e61431b6e3;hb=e663f81f7297ab9f53b38d5f0975152de3557e69;hp=b4e5bba343a93bb373a1b41192ed8a2c7414fe4d;hpb=0b5119848b6b8713e473fa669356645747e11dbd;p=sbcl.git

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index b4e5bba..bc56053 100644
--- 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)
-           (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)
@@ -110,6 +109,11 @@
       (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")
@@ -151,8 +155,7 @@
 (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)))
@@ -176,7 +179,7 @@
              (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*))))
@@ -460,22 +463,13 @@
 
 (format t "~&session lock test done~%")
 
-(wait-for-threads
- (loop for i below 2000 collect
-       (sb-thread:make-thread (lambda ()))))
+(loop repeat 20 do
+      (wait-for-threads
+       (loop for i below 100 collect
+             (sb-thread:make-thread (lambda ())))))
 
 (format t "~&creation test done~%")
 
-;; watch out for *current-thread* being the parent thread after exit
-(let* (sap
-       (thread (sb-thread:make-thread
-                (lambda ()
-                  (setq sap (thread-sap-for-id
-                             (thread-os-thread *current-thread*)))))))
-  (wait-for-threads (list thread))
-  (assert (null (symbol-value-in-thread 'sb-thread:*current-thread*
-                                        sap))))
-
 ;; interrupt handlers are per-thread with pthreads, make sure the
 ;; handler installed in one thread is global
 (sb-thread:make-thread