From 66b919851a8564e8f21247703d54c01c293414f8 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 13 Mar 2008 18:35:48 +0000 Subject: [PATCH] 1.0.15.30: thread-safe FIND-CLASS * Reported by Attila Lendvai. ...I could have sworn I did this already... --- NEWS | 1 + doc/internals-notes/threading-specials | 4 +++- src/pcl/macros.lisp | 12 +++++++----- tests/threads.pure.lisp | 16 ++++++++++++++-- version.lisp-expr | 2 +- 5 files changed, 26 insertions(+), 9 deletions(-) diff --git a/NEWS b/NEWS index 2a47167..7b33017 100644 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4