Rework test infrastructure to keep track of tests which are disabled
[sbcl.git] / tests / threads.pure.lisp
index 9b6e91e..26c70f1 100644 (file)
@@ -51,9 +51,9 @@
 
 ;;; Condition-wait should not be interruptible under WITHOUT-INTERRUPTS
 
-#+sb-thread
 (with-test (:name without-interrupts+condition-wait
-            :fails-on :sb-lutex)
+            :fails-on :sb-lutex
+           :skipped-on '(not :sb-thread))
   (let* ((lock (make-mutex))
          (queue (make-waitqueue))
          (thread (make-thread (lambda ()
@@ -71,8 +71,7 @@
 
 ;;; GET-MUTEX should not be interruptible under WITHOUT-INTERRUPTS
 
-#+sb-thread
-(with-test (:name without-interrupts+get-mutex)
+(with-test (:name without-interrupts+get-mutex :skipped-on '(not :sb-thread))
   (let* ((lock (make-mutex))
          (bar (progn (get-mutex lock) nil))
          (thread (make-thread (lambda ()
@@ -90,8 +89,7 @@
     (assert (eq :aborted (join-thread thread :default :aborted)))
     (assert bar)))
 
-#+sb-thread
-(with-test (:name parallel-find-class)
+(with-test (:name parallel-find-class :skipped-on '(not :sb-thread))
   (let* ((oops nil)
          (threads (loop repeat 10
                         collect (make-thread (lambda ()
     (mapcar #'sb-thread:join-thread threads)
     (assert (not oops))))
 
-#+sb-thread
-(with-test (:name :semaphore-multiple-waiters)
+(with-test (:name :semaphore-multiple-waiters :skipped-on '(not :sb-thread))
   (let ((semaphore (make-semaphore :name "test sem")))
     (labels ((make-readers (n i)
                (values
 
 ;;;; Printing waitqueues
 
-#+sb-thread
-(with-test (:name :waitqueue-circle-print)
+(with-test (:name :waitqueue-circle-print :skipped-on '(not :sb-thread))
   (let* ((*print-circle* nil)
          (lock (sb-thread:make-mutex))
          (wq (sb-thread:make-waitqueue)))
     (assert (= 123 (symbol-value-in-thread '* *current-thread*)))
     (assert (= 123 *))))
 
-#+sb-thread
-(with-test (:name symbol-value-in-thread.2)
+(with-test (:name symbol-value-in-thread.2 :skipped-on '(not :sb-thread))
   (let* ((parent *current-thread*)
          (semaphore (make-semaphore))
          (child (make-thread (lambda ()
 ;;; wich _appear_ to be caused by malloc() and free() not being thread safe: an
 ;;; interrupted malloc in one thread can apparently block a free in another. There
 ;;; are also some indications that pthread_mutex_lock is not re-entrant.
-#+(and sb-thread (not darwin))
-(with-test (:name symbol-value-in-thread.3)
+(with-test (:name symbol-value-in-thread.3 :skipped-on '(not :sb-thread) :broken-on :darwin)
   (let* ((parent *current-thread*)
          (semaphore (make-semaphore))
          (running t)
     (setf running nil)
     (join-thread noise)))
 
-#+sb-thread
-(with-test (:name symbol-value-in-thread.4)
+(with-test (:name symbol-value-in-thread.4 :skipped-on '(not :sb-thread))
   (let* ((parent *current-thread*)
          (semaphore (make-semaphore))
          (child (make-thread (lambda ()
     (signal-semaphore semaphore)
     (assert (equal '(nil nil) (multiple-value-list (join-thread child))))))
 
-#+sb-thread
-(with-test (:name symbol-value-in-thread.5)
+(with-test (:name symbol-value-in-thread.5 :skipped-on '(not :sb-thread))
   (let* ((parent *current-thread*)
          (semaphore (make-semaphore))
          (child (make-thread (lambda ()
     (assert (equal (list *current-thread* 'this-is-new (list :read :unbound-in-thread))
                    (join-thread child)))))
 
-#+sb-thread
-(with-test (:name symbol-value-in-thread.6)
+(with-test (:name symbol-value-in-thread.6 :skipped-on '(not :sb-thread))
   (let* ((parent *current-thread*)
          (semaphore (make-semaphore))
          (name (gensym))
       (unless (equal res want)
         (error "wanted ~S, got ~S" want res)))))
 
-#+sb-thread
-(with-test (:name symbol-value-in-thread.7)
+(with-test (:name symbol-value-in-thread.7 :skipped-on '(not :sb-thread))
   (let ((child (make-thread (lambda ())))
         (error-occurred nil))
     (join-thread child)
                        (sb-thread::symbol-value-in-thread-error-info e)))))
     (assert error-occurred)))
 
-#+sb-thread
-(with-test (:name symbol-value-in-thread.8)
+(with-test (:name symbol-value-in-thread.8  :skipped-on '(not :sb-thread))
   (let ((child (make-thread (lambda ())))
         (error-occurred nil))
     (join-thread child)
                        (sb-thread::symbol-value-in-thread-error-info e)))))
     (assert error-occurred)))
 
-#+sb-thread
-(with-test (:name deadlock-detection.1)
+(with-test (:name deadlock-detection.1  :skipped-on '(not :sb-thread))
   (loop
     repeat 1000
     do (flet ((test (ma mb sa sb)
                          (equal '(:ok :deadlock) res)
                          (equal '(:deadlock :deadlock) res))))))))
 
-#+sb-thread
-(with-test (:name deadlock-detection.2)
+(with-test (:name deadlock-detection.2 :skipped-on '(not :sb-thread))
   (let* ((m1 (sb-thread:make-mutex :name "M1"))
          (m2 (sb-thread:make-mutex :name "M2"))
          (s1 (sb-thread:make-semaphore :name "S1"))
        (assert (stringp err)))
     (assert (eq :ok (sb-thread:join-thread t1)))))
 
-#+sb-thread
-(with-test (:name deadlock-detection.3)
+(with-test (:name deadlock-detection.3  :skipped-on '(not :sb-thread))
   (let* ((m1 (sb-thread:make-mutex :name "M1"))
          (m2 (sb-thread:make-mutex :name "M2"))
          (s1 (sb-thread:make-semaphore :name "S1"))
                     :deadlock))))
     (assert (eq :ok (join-thread t1)))))
 
-#+sb-thread
-(with-test (:name deadlock-detection.4)
+(with-test (:name deadlock-detection.4  :skipped-on '(not :sb-thread))
   (loop
     repeat 1000
     do (flet ((test (ma mb sa sb)
                          (equal '(:ok :deadlock) res)
                          (equal '(:deadlock :deadlock) res))))))))
 
-#+sb-thread
-(with-test (:name deadlock-detection.5)
+(with-test (:name deadlock-detection.5 :skipped-on '(not :sb-thread))
   (let* ((m1 (sb-thread::make-spinlock :name "M1"))
          (m2 (sb-thread::make-spinlock :name "M2"))
          (s1 (sb-thread:make-semaphore :name "S1"))
        (assert (stringp err)))
     (assert (eq :ok (sb-thread:join-thread t1)))))
 
-#+sb-thread
-(with-test (:name deadlock-detection.7)
+(with-test (:name deadlock-detection.7 :skipped-on '(not :sb-thread))
   (let* ((m1 (sb-thread::make-spinlock :name "M1"))
          (m2 (sb-thread::make-spinlock :name "M2"))
          (s1 (sb-thread:make-semaphore :name "S1"))