[Sbcl-commits] CVS: sbcl/tests threads.impure.lisp,1.29,1.30

[<me...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30441/tests

Modified Files:
	threads.impure.lisp 
Log Message:
0.9.5.34:
  * grab all_threads_lock for the duration of creating and linking a
    thread struct to avoid gc lossage (reinstated STATE_STARTING and
    recomplicated thread start vs gc interaction)
  * fixed thread creation test


Index: threads.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/threads.impure.lisp,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -d -r1.29 -r1.30
--- threads.impure.lisp	7 Oct 2005 11:18:10 -0000	1.29
+++ threads.impure.lisp	11 Oct 2005 09:31:32 -0000	1.30
@@ -179,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*))))
@@ -463,9 +463,10 @@
 
 (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~%")
 
@@ -485,6 +486,21 @@
  (lambda ()
    (sb-ext:run-program "sleep" '("1") :search t :wait nil)))
 
+(with-test (:name (:thread-start :dynamic-values-and-gc))
+  (let ((gc-thread (sb-thread:make-thread (lambda ()
+                                            (loop (sleep (random 0.2))
+                                                  (sb-ext:gc :full t))))))
+    (wait-for-threads
+     (loop for i below 3000
+           when (zerop (mod i 30))
+           do (princ ".")
+           collect
+           (let ((*x* (lambda ())))
+             (declare (special *x*))
+             (sb-thread:make-thread (lambda () (functionp *x*))))))
+    (sb-thread:terminate-thread gc-thread)
+    (terpri)))
+
 #|  ;; a cll post from eric marsden
 | (defun crash ()
 |   (setq *debugger-hook*