1.0.9.41: Fix test on unthreaded config.
authorNIIMI Satoshi <sa2c@users.sourceforge.net>
Sat, 8 Sep 2007 00:18:18 +0000 (00:18 +0000)
committerNIIMI Satoshi <sa2c@users.sourceforge.net>
Sat, 8 Sep 2007 00:18:18 +0000 (00:18 +0000)
tests/threads.impure.lisp
version.lisp-expr

index 068d68b..867f408 100644 (file)
 
 (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)
                                                              (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*))
index be5e80c..3a0bf39 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.9.40"
+"1.0.9.41"