[elephant-devel] Concurrency problem?

[Pierre THIERRY]

Scribit Pierre THIERRY dies 06/11/2006 hora 14:40:
> FWIW, since this patch [...]

And since I'm not that much proud of the patch, I forgot to attach it!

Quickly,
Nowhere man
-- 
nowhere.man at levallois.eu.org
OpenPGP 0xD9D50D8A
-------------- next part --------------
Index: elephant/elephant.asd
===================================================================
--- elephant.orig/elephant.asd	2006-11-05 23:29:59.244904250 +0100
+++ elephant/elephant.asd	2006-11-05 23:32:24.469980250 +0100
@@ -112,7 +112,7 @@
 		       (:file "backend"))
 		      :serial t
 		      :depends-on (memutil)))))
-  :depends-on (:uffi))
+  :depends-on (:uffi :bordeaux-threads))
 
 
 
Index: elephant/src/elephant/classes.lisp
===================================================================
--- elephant.orig/src/elephant/classes.lisp	2006-11-05 23:30:09.045516750 +0100
+++ elephant/src/elephant/classes.lisp	2006-11-06 00:14:03.970189250 +0100
@@ -233,44 +233,51 @@
 ;; SLOT ACCESS PROTOCOLS
 ;;
 
+(defvar *slot-lock* (make-lock "Slot access lock"))
+
 (defmethod slot-value-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Get the slot value from the database."
   (declare (optimize (speed 3)))
-  (let ((name (slot-definition-name slot-def)))
-    (persistent-slot-reader (get-con instance) instance name)))
+  (with-lock-held (*slot-lock*)
+    (let ((name (slot-definition-name slot-def)))
+      (persistent-slot-reader (get-con instance) instance name))))
 
 (defmethod (setf slot-value-using-class) :around (new-value (class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Set the slot value in the database."
   (declare (optimize (speed 3)))
-  (if (indexed class)
-      (indexed-slot-writer class instance slot-def new-value)
-      (let ((name (slot-definition-name slot-def)))
-	(persistent-slot-writer (get-con instance) new-value instance name))))
+  (with-recursive-lock-held (*slot-lock*)
+    (if (indexed class)
+	(indexed-slot-writer class instance slot-def new-value)
+	(let ((name (slot-definition-name slot-def)))
+	  (persistent-slot-writer (get-con instance) new-value instance name)))))
 
 (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Checks if the slot exists in the database."
   (declare (optimize (speed 3)))
-  (let ((name (slot-definition-name slot-def)))
-    (persistent-slot-boundp (get-con instance) instance name)))
+  (with-recursive-lock-held (*slot-lock*)
+    (let ((name (slot-definition-name slot-def)))
+      (persistent-slot-boundp (get-con instance) instance name))))
 
 (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-name symbol))
   "Checks if the slot exists in the database."
   (declare (optimize (speed 3)))
-  (loop for slot in (class-slots class)
-	for matches-p = (eq (slot-definition-name slot) slot-name)
-	until matches-p
-	finally (return (if (and matches-p
-				 (subtypep (type-of slot) 'persistent-slot-definition))
-			    (persistent-slot-boundp (get-con instance) instance slot-name)
-			    (call-next-method)))))
+  (with-recursive-lock-held (*slot-lock*)
+    (loop for slot in (class-slots class)
+	  for matches-p = (eq (slot-definition-name slot) slot-name)
+	  until matches-p
+	  finally (return (if (and matches-p
+				   (subtypep (type-of slot) 'persistent-slot-definition))
+			      (persistent-slot-boundp (get-con instance) instance slot-name)
+			      (call-next-method))))))
 
 (defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition))
   "Deletes the slot from the database."
   (declare (optimize (speed 3)))
   ;; NOTE: call remove-indexed-slot here instead?
-  (when (indexed slot-def)
-    (unregister-indexed-slot class (slot-definition-name slot-def)))
-  (persistent-slot-makunbound (get-con instance) instance (slot-definition-name slot-def)))
+  (with-recursive-lock-held (*slot-lock*)
+    (when (indexed slot-def)
+      (unregister-indexed-slot class (slot-definition-name slot-def)))
+    (persistent-slot-makunbound (get-con instance) instance (slot-definition-name slot-def))))
 
 ;; ======================================================
 ;; Handling metaclass overrides of normal slot operation
Index: elephant/src/elephant/package.lisp
===================================================================
--- elephant.orig/src/elephant/package.lisp	2006-11-05 23:29:59.400914000 +0100
+++ elephant/src/elephant/package.lisp	2006-11-05 23:30:24.186463000 +0100
@@ -20,7 +20,7 @@
 (in-package :cl-user)
 
 (defpackage elephant
-  (:use common-lisp elephant-memutil)
+  (:use common-lisp elephant-memutil bordeaux-threads)
   (:nicknames ele :ele)
   (:documentation 
    "Elephant: an object-oriented database for Common Lisp with
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
URL: <https://mailman.common-lisp.net/pipermail/elephant-devel/attachments/20061107/56fdaf88/attachment.sig>