X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fthreads.pure.lisp;h=ea80fa33e06d9b4c2794953c52b2fe9cd98432ff;hb=7c15c5c42fb392729728d8b3c7eeee734e4375a3;hp=e785e736c77e96769d1bd229a3cf3812bb79d081;hpb=126b9cfb25799ca41210c1a1658de30e1ff372e7;p=sbcl.git

diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp
index e785e73..ea80fa3 100644
--- a/tests/threads.pure.lisp
+++ b/tests/threads.pure.lisp
@@ -20,21 +20,23 @@
 
 (use-package :test-util)
 
-(with-test (:name atomic-update)
-  (let ((x (cons :count 0)))
+(with-test (:name atomic-update
+            :skipped-on '(not :sb-thread))
+  (let ((x (cons :count 0))
+        (nthreads (ecase sb-vm:n-word-bits (32 100) (64 1000))))
     (mapc #'sb-thread:join-thread
-          (loop repeat 1000
+          (loop repeat nthreads
                 collect (sb-thread:make-thread
                          (lambda ()
                            (loop repeat 1000
                                  do (atomic-update (cdr x) #'1+)
                                     (sleep 0.00001))))))
-    (assert (equal x '(:count . 1000000)))))
+    (assert (equal x `(:count ,@(* 1000 nthreads))))))
 
 (with-test (:name mutex-owner)
   ;; Make sure basics are sane on unithreaded ports as well
   (let ((mutex (make-mutex)))
-    (get-mutex mutex)
+    (grab-mutex mutex)
     (assert (eq *current-thread* (mutex-value mutex)))
     (handler-bind ((warning #'error))
       (release-mutex mutex))
@@ -54,7 +56,8 @@
 ;;; Condition-wait should not be interruptible under WITHOUT-INTERRUPTS
 
 (with-test (:name without-interrupts+condition-wait
-            :skipped-on '(not :sb-thread))
+            :skipped-on '(not :sb-thread)
+            :fails-on '(and :win32 :sb-futex))
   (let* ((lock (make-mutex))
          (queue (make-waitqueue))
          (thread (make-thread (lambda ()
@@ -70,11 +73,11 @@
     (sleep 1)
     (assert (not (thread-alive-p thread)))))
 
-;;; GET-MUTEX should not be interruptible under WITHOUT-INTERRUPTS
+;;; GRAB-MUTEX should not be interruptible under WITHOUT-INTERRUPTS
 
-(with-test (:name without-interrupts+get-mutex :skipped-on '(not :sb-thread))
+(with-test (:name without-interrupts+grab-mutex :skipped-on '(not :sb-thread))
   (let* ((lock (make-mutex))
-         (bar (progn (get-mutex lock) nil))
+         (bar (progn (grab-mutex lock) nil))
          (thread (make-thread (lambda ()
                                 (sb-sys:without-interrupts
                                     (with-mutex (lock)
@@ -206,7 +209,7 @@
                                         (loop repeat (random 128)
                                               do (setf ** *)))))))
     (write-string "; ")
-    (dotimes (i 15000)
+    (dotimes (i #+win32 2000 #-win32 15000)
       (when (zerop (mod i 200))
         (write-char #\.)
         (force-output))
@@ -493,12 +496,12 @@
             :skipped-on '(not :sb-thread))
   (assert (eq :error
               (handler-case
-                  (join-thread (make-thread (lambda () (sleep 10))) :timeout 0.01)
+                  (join-thread (make-join-thread (lambda () (sleep 10))) :timeout 0.01)
                 (join-thread-error ()
                   :error))))
   (let ((cookie (cons t t)))
     (assert (eq cookie
-                (join-thread (make-thread (lambda () (sleep 10)))
+                (join-thread (make-join-thread (lambda () (sleep 10)))
                              :timeout 0.01
                              :default cookie)))))
 
@@ -524,7 +527,7 @@
                    #+sb-thread
                    (sb-thread::block-deferrable-signals))))))
       (let* ((threads (loop for i from 1 upto 100
-                            collect (make-thread #'critical :name (format nil "T~A" i))))
+                            collect (make-join-thread #'critical :name (format nil "T~A" i))))
              (safe nil)
              (unsafe nil)
              (interruptor (make-thread (lambda ()
@@ -559,7 +562,8 @@
     (try-semaphore sem 1 note)
     (assert (semaphore-notification-status note))))
 
-(with-test (:name (:return-from-thread :normal-thread))
+(with-test (:name (:return-from-thread :normal-thread)
+            :skipped-on '(not :sb-thread))
   (let* ((thread (make-thread (lambda ()
                                 (return-from-thread (values 1 2 3))
                                 :foo)))
@@ -575,7 +579,8 @@
                 (thread-error ()
                   :oops)))))
 
-(with-test (:name (:abort-thread :normal-thread))
+(with-test (:name (:abort-thread :normal-thread)
+            :skipped-on '(not :sb-thread))
   (let ((thread (make-thread (lambda ()
                                (abort-thread)
                                :foo))))