[bknr-cvs] hans changed trunk/bknr/datastore/src/indices/indices.lisp

[BKNR Commits]

Revision: 3945
Author: hans
URL: http://bknr.net/trac/changeset/3945

make hash tables thread safe for sbcl

U   trunk/bknr/datastore/src/indices/indices.lisp

Modified: trunk/bknr/datastore/src/indices/indices.lisp
===================================================================
--- trunk/bknr/datastore/src/indices/indices.lisp	2008-09-22 18:53:45 UTC (rev 3944)
+++ trunk/bknr/datastore/src/indices/indices.lisp	2008-09-22 19:18:24 UTC (rev 3945)
@@ -27,7 +27,7 @@
   (unless (= (length slots) 1)
     (error "Exactly one slot name in :SLOTS initarg required to create a SLOT-INDEX"))
   (with-slots (hash-table slot-name) index
-    (setf hash-table (make-hash-table :test test)
+    (setf hash-table (make-hash-table :test test #+sbcl #+sbcl :synchronized t)
 	  slot-name (first slots)
 	  (slot-value index 'index-nil) index-nil)))
 
@@ -65,7 +65,7 @@
 
 (defmethod index-clear ((index slot-index))
   (with-slots (hash-table) index
-    (setf hash-table (make-hash-table :test (hash-table-test hash-table)))))
+    (setf hash-table (make-hash-table :test (hash-table-test hash-table) #+sbcl #+sbcl :synchronized t))))
 
 (defmethod index-reinitialize ((new-index slot-index)
 			       (old-index slot-index))
@@ -110,7 +110,7 @@
 
 (defmethod initialize-instance :after ((index string-unique-index) &key (test #'equal))
   (with-slots (hash-table) index
-    (setf hash-table (make-hash-table :test test))))
+    (setf hash-table (make-hash-table :test test #+sbcl #+sbcl :synchronized t))))
 
 (defmethod index-add :around ((index string-unique-index) object)
   (unless (slot-boundp object (slot-index-slot-name index))
@@ -421,7 +421,7 @@
   (unless (<= (length slots) 1)
     (error "Can not create slot-index with more than one slot."))
   (with-slots (hash-table slot-name) index
-    (setf hash-table (make-hash-table :test test)
+    (setf hash-table (make-hash-table :test test #+sbcl #+sbcl :synchronized t)
 	  slot-name (first slots)
 	  (slot-value index 'index-superclasses) index-superclasses)))
 
@@ -490,7 +490,7 @@
 
 (defmethod index-clear ((index class-skip-index))
   (with-slots (hash-table) index
-    (setf hash-table (make-hash-table :test (hash-table-test hash-table)))))
+    (setf hash-table (make-hash-table :test (hash-table-test hash-table) #+sbcl #+sbcl :synchronized t))))
 
 (defmethod index-keys ((index class-skip-index))
   (loop for key being the hash-keys of (class-skip-index-hash-table index)