X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fthreads.impure.lisp;h=c68b61518da484e4fe9ebcd79245da81760d058f;hb=87cd7d9848d9beddbf74e9d56a0c0aea6e189ead;hp=cbf5ce6a34cbe1226bb1c88f817facacbbdebd2f;hpb=828bcd9589641a560e01c2f2bc9134a0aaacd552;p=sbcl.git

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index cbf5ce6..c68b615 100644
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -13,15 +13,45 @@
 
 (in-package "SB-THREAD") ; this is white-box testing, really
 
+(use-package :test-util)
+(use-package "ASSERTOID")
+
+(setf sb-unix::*on-dangerous-select* :error)
+
+(defun wait-for-threads (threads)
+  (mapc (lambda (thread) (sb-thread:join-thread thread :default nil)) threads)
+  (assert (not (some #'sb-thread:thread-alive-p threads))))
+
+(assert (eql 1 (length (list-all-threads))))
+
+(assert (eq *current-thread*
+            (find (thread-name *current-thread*) (list-all-threads)
+                  :key #'thread-name :test #'equal)))
+
+(assert (thread-alive-p *current-thread*))
+
+(let ((a 0))
+  (interrupt-thread *current-thread* (lambda () (setq a 1)))
+  (assert (eql a 1)))
+
+(let ((spinlock (make-spinlock)))
+  (with-spinlock (spinlock)))
+
+(let ((mutex (make-mutex)))
+  (with-mutex (mutex)
+    mutex))
+
+#-sb-thread (sb-ext:quit :unix-status 104)
+
 ;;; compare-and-swap
 
 (defmacro defincf (name accessor &rest args)
   `(defun ,name (x)
      (let* ((old (,accessor x ,@args))
-	 (new (1+ old)))
+         (new (1+ old)))
     (loop until (eq old (sb-ext:compare-and-swap (,accessor x ,@args) old new))
        do (setf old (,accessor x ,@args)
-		new (1+ old)))
+                new (1+ old)))
     new)))
 
 (defstruct cas-struct (slot 0))
@@ -38,62 +68,33 @@
      (defun ,name (n)
        (declare (fixnum n))
        (let* ((x ,init)
-	      (run nil)
-	      (threads
-	       (loop repeat 10
-		     collect (sb-thread:make-thread 
-			      (lambda () 
-				(loop until run)
-				(loop repeat n do (,incf x)))))))
-	 (setf run t)
-	 (dolist (th threads) 
-	   (sb-thread:join-thread th))
-	 (assert (= (,op x) (* 10 n)))))
+              (run nil)
+              (threads
+               (loop repeat 10
+                     collect (sb-thread:make-thread
+                              (lambda ()
+                                (loop until run
+                                   do (sb-thread:thread-yield))
+                                (loop repeat n do (,incf x)))))))
+         (setf run t)
+         (dolist (th threads)
+           (sb-thread:join-thread th))
+         (assert (= (,op x) (* 10 n)))))
      (,name 200000)))
 
 (def-test-cas test-cas-car (cons 0 nil) incf-car car)
 (def-test-cas test-cas-cdr (cons nil 0) incf-cdr cdr)
 (def-test-cas test-cas-slot (make-cas-struct) incf-slot cas-struct-slot)
 (def-test-cas test-cas-value (let ((x '.x.))
-			       (set x 0)
-			       x)
+                               (set x 0)
+                               x)
   incf-symbol-value symbol-value)
 (def-test-cas test-cas-svref/0 (vector 0 nil) incf-svref/0 (lambda (x)
-							     (svref x 0)))
+                                                             (svref x 0)))
 (def-test-cas test-cas-svref/1 (vector nil 0) incf-svref/1 (lambda (x)
-							     (svref x 1)))
+                                                             (svref x 1)))
 (format t "~&compare-and-swap tests done~%")
 
-(use-package :test-util)
-(use-package "ASSERTOID")
-
-(setf sb-unix::*on-dangerous-select* :error)
-
-(defun wait-for-threads (threads)
-  (mapc (lambda (thread) (sb-thread:join-thread thread :default nil)) threads)
-  (assert (not (some #'sb-thread:thread-alive-p threads))))
-
-(assert (eql 1 (length (list-all-threads))))
-
-(assert (eq *current-thread*
-            (find (thread-name *current-thread*) (list-all-threads)
-                  :key #'thread-name :test #'equal)))
-
-(assert (thread-alive-p *current-thread*))
-
-(let ((a 0))
-  (interrupt-thread *current-thread* (lambda () (setq a 1)))
-  (assert (eql a 1)))
-
-(let ((spinlock (make-spinlock)))
-  (with-spinlock (spinlock)))
-
-(let ((mutex (make-mutex)))
-  (with-mutex (mutex)
-    mutex))
-
-#-sb-thread (sb-ext:quit :unix-status 104)
-
 (let ((old-threads (list-all-threads))
       (thread (make-thread (lambda ()
                              (assert (find *current-thread* *all-threads*))