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

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index f9bec10..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*))))
@@ -313,7 +316,7 @@
     (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)))
@@ -460,23 +463,13 @@
 
 (format t "~&session lock test done~%")
 
-(sb-ext:gc :full t)
 (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~%")
 
-;; 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