Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv32105/tests
Modified Files:
threads.pure.lisp
Log Message:
1.0.15.30: thread-safe FIND-CLASS
* Reported by Attila Lendvai.
...I could have sworn I did this already...
Index: threads.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/threads.pure.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- threads.pure.lisp 3 Jul 2007 10:21:22 -0000 1.3
+++ threads.pure.lisp 13 Mar 2008 18:35:49 -0000 1.4
@@ -54,8 +54,7 @@
;;; GET-MUTEX should not be interruptible under WITHOUT-INTERRUPTS
#+sb-thread
-(with-test (:name without-interrupts+get-mutex
- :fails-on :sb-lutex)
+(with-test (:name without-interrupts+get-mutex)
(let* ((lock (make-mutex))
(foo (get-mutex lock))
(bar nil)
@@ -73,3 +72,16 @@
(assert (not (thread-alive-p thread)))
(assert (eq :aborted (join-thread thread :default :aborted)))
(assert bar)))
+
+#+sb-thread
+(with-test (:name parallel-find-class)
+ (let* ((oops nil)
+ (threads (loop repeat 10
+ collect (make-thread (lambda ()
+ (handler-case
+ (loop repeat 10000
+ do (find-class (gensym) nil))
+ (serious-condition ()
+ (setf oops t))))))))
+ (mapcar #'sb-thread:join-thread threads)
+ (assert (not oops))))
|