From 119c1bcd2cfff74d2968209207ea34ba0e1739f7 Mon Sep 17 00:00:00 2001 From: NIIMI Satoshi Date: Sat, 8 Sep 2007 00:18:18 +0000 Subject: [PATCH] 1.0.9.41: Fix test on unthreaded config. --- tests/threads.impure.lisp | 60 ++++++++++++++++++++++----------------------- version.lisp-expr | 2 +- 2 files changed, 31 insertions(+), 31 deletions(-) diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp index 068d68b..867f408 100644 --- a/tests/threads.impure.lisp +++ b/tests/threads.impure.lisp @@ -13,6 +13,36 @@ (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) @@ -64,36 +94,6 @@ (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*)) diff --git a/version.lisp-expr b/version.lisp-expr index be5e80c..3a0bf39 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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" -- 1.7.10.4