support deadlock detected error, requires postmodern patches
Mon Nov 24 06:59:47 PST 2008 attila.lendvai@gmail.com
* support deadlock detected error, requires postmodern patches
Warning: CRC errors found. These are probably harmless but should be repaired.
See 'darcs gzcrcs --help' for more information.
diff -rN -u old-cl-rdbms/database.lisp new-cl-rdbms/database.lisp
--- old-cl-rdbms/database.lisp 2014-07-27 21:16:58.000000000 -0700
+++ new-cl-rdbms/database.lisp 2014-07-27 21:16:58.000000000 -0700
@@ -24,27 +24,36 @@
:utf-8
:type (member :utf-8 :us-ascii))))
-(defcondition* rdbms-error ()
+(def (condition* e) rdbms-error ()
())
(defcondition* translated-rdbms-error (rdbms-error)
((original-error)))
-(defcondition* simple-rdbms-error (simple-error)
+(def condition* simple-rdbms-error (simple-error)
())
(defun simple-rdbms-error (message &rest args)
(error 'simple-rdbms-error :format-control message :format-arguments args))
-(defcondition* unable-to-obtain-lock-error (translated-rdbms-error simple-rdbms-error)
+(def (condition* e) unable-to-obtain-lock-error (translated-rdbms-error simple-rdbms-error)
())
-(defun unable-to-obtain-lock-error (message-or-nested-condition)
- (error 'unable-to-obtain-lock-error
+(defun %signal-translated-simple-rdbms-error (type message-or-nested-condition)
+ (error type
:format-control (princ-to-string message-or-nested-condition)
:original-error (when (typep message-or-nested-condition 'condition)
message-or-nested-condition)))
+(defun unable-to-obtain-lock-error (message-or-nested-condition)
+ (%signal-translated-simple-rdbms-error 'unable-to-obtain-lock-error message-or-nested-condition))
+
+(def (condition* e) deadlock-detected-error (translated-rdbms-error simple-rdbms-error)
+ ())
+
+(defun deadlock-detected-error (message-or-nested-condition)
+ (%signal-translated-simple-rdbms-error 'deadlock-detected-error message-or-nested-condition))
+
(defmethod shared-initialize :after ((database database) slot-names
&key transaction-mixin generated-transaction-class-name &allow-other-keys)
(let ((classes (mapcar #'find-class (transaction-mixin-class database))))
diff -rN -u old-cl-rdbms/package.lisp new-cl-rdbms/package.lisp
--- old-cl-rdbms/package.lisp 2014-07-27 21:16:58.000000000 -0700
+++ new-cl-rdbms/package.lisp 2014-07-27 21:16:58.000000000 -0700
@@ -32,9 +32,6 @@
)
(:export
- #:rdbms-error
- #:unable-to-obtain-lock-error
-
#:database
#:postgresql
#:postgresql-postmodern