1.0.15.30: thread-safe FIND-CLASS

  * Reported by Attila Lendvai.

  ...I could have sworn I did this already...

diff --git a/NEWS b/NEWS
index 2a47167..7b33017 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,7 @@ changes in sbcl-1.0.16 relative to 1.0.15:
   * optimization: modular arithmetic for a particular requested width
     is implemented using a tagged representation unless a better 
     representation is available.
+  * bug fix: FIND-CLASS was not thread-safe. (reported by Attila Lendvai)
   * bug fix: ~R was broken for vigtillions. (thanks to Luis Oliveira)
   * bug fix: attempt to obtain *SCHEDULER-LOCK* recursively when
     unscheduling timer at the same time as another timer fires.

diff --git a/doc/internals-notes/threading-specials b/doc/internals-notes/threading-specials
index fd71da7..705832b 100644 (file)
--- a/doc/internals-notes/threading-specials
+++ b/doc/internals-notes/threading-specials
@@ -109,6 +109,9 @@ but sometimes it can be hard to tell...
 The most suspicious parts should probably be tested by asserting
 at various sites that the *PCL-LOCK* is held.
 
+accesses locked with a nice granularity
+   SB-PCL::*FIND-CLASS*
+
 read-only & safe:
    SB-PCL::*BUILT-IN-TYPEP-COST* 
    SB-PCL::*CACHE-EXPAND-THRESHOLD* 
@@ -188,7 +191,6 @@ SB-PCL::*EMIT-FUNCTION-P*
 SB-PCL::*ENABLE-DFUN-CONSTRUCTOR-CACHING* 
 SB-PCL::*ENABLE-EMF-CALL-TRACING-P* 
 SB-PCL::*EQL-SPECIALIZER-TABLE* 
-SB-PCL::*FIND-CLASS* 
 SB-PCL::*GLOBAL-EFFECTIVE-METHOD-GENSYMS* 
 SB-PCL::*IN-GF-ARG-INFO-P* 
 SB-PCL::*IN-PRECOMPUTE-EFFECTIVE-METHODS-P* 

diff --git a/src/pcl/macros.lisp b/src/pcl/macros.lisp
index ad4e24f..bc6fdf1 100644 (file)
--- a/src/pcl/macros.lisp
+++ b/src/pcl/macros.lisp
@@ -92,11 +92,13 @@
   '(list* nil #'constantly-nil nil))
 
 (defun find-class-cell (symbol &optional dont-create-p)
-  (or (gethash symbol *find-class*)
-      (unless dont-create-p
-        (unless (legal-class-name-p symbol)
-          (error "~S is not a legal class name." symbol))
-        (setf (gethash symbol *find-class*) (make-find-class-cell symbol)))))
+  (let ((table *find-class*))
+    (with-locked-hash-table (table)
+      (or (gethash symbol table)
+          (unless dont-create-p
+            (unless (legal-class-name-p symbol)
+              (error "~S is not a legal class name." symbol))
+            (setf (gethash symbol table) (make-find-class-cell symbol)))))))
 
 (/show "pcl/macros.lisp 157")
 

diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp
index 3d7d524..ef019a4 100644 (file)
--- a/tests/threads.pure.lisp
+++ b/tests/threads.pure.lisp
@@ -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))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 266790d..c90cbf0 100644 (file)
--- 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.15.29"
+"1.0.15.30"