[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/sqlite 78e795a 2/2: Tweak multisession stuff and improve concurr
From: |
Lars Ingebrigtsen |
Subject: |
scratch/sqlite 78e795a 2/2: Tweak multisession stuff and improve concurrency |
Date: |
Sun, 12 Dec 2021 23:39:38 -0500 (EST) |
branch: scratch/sqlite
commit 78e795a546906bb73a974247676fbe2f5f21439c
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Tweak multisession stuff and improve concurrency
---
doc/lispref/variables.texi | 13 +++++-----
lisp/emacs-lisp/multisession.el | 38 +++++++++++++-----------------
src/sqlite.c | 13 ++++++++--
test/lisp/emacs-lisp/multisession-tests.el | 24 ++++++++++++-------
4 files changed, 50 insertions(+), 38 deletions(-)
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index c07d795..ff67ffd 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -2805,12 +2805,13 @@ of the @var{name} symbol name. For instance, if
@var{name} is
default to @code{foo}.
@item :synchronized bool
-By default, multisession variables are @dfn{synchronized}. This means
-that if there's two concurrent Emacs instances running, and the other
-Emacs changes the multisession variable @code{foo-var}, the current
-Emacs instance will retrieve that data when accessing the value. If
-@var{synchronized} is @code{nil}, this won't happen, and the variable
-in all Emacs sessions will be independent.
+Multisession variables can be @dfn{synchronized} if this keyword is
+non-@code{nil}. This means that if there's two concurrent Emacs
+instances running, and the other Emacs changes the multisession
+variable @code{foo-var}, the current Emacs instance will retrieve that
+data when accessing the value. If @var{synchronized} is @code{nil} or
+missing, this won't happen, and the variable in all Emacs sessions
+will be independent.
@end table
@end defmac
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index 96617e2..1425bf2 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -27,8 +27,6 @@
(require 'eieio)
(require 'sqlite)
-(define-error 'sqlite-locked-error "database locked")
-
(defcustom multisession-database-file
(expand-file-name "multisession.sqlite" user-emacs-directory)
"File to store multisession variables."
@@ -36,6 +34,7 @@
:version "29.1"
:group 'files)
+;;;###autoload
(defmacro define-multisession-variable (name initial-value &optional doc
&rest args)
"Make NAME into a multisession variable initialized from INITIAL-VALUE.
@@ -56,11 +55,12 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
key
(initial-value nil)
package
- (synchronized t)
- (cached-value :)
+ (synchronized nil)
+ ;; We need an "impossible" value for the unbound case.
+ (cached-value (make-marker))
(cached-sequence 0))
-(cl-defun make-multisession (&key key initial-value package)
+(cl-defun make-multisession (&key key initial-value package synchronized)
"Create a multisession object."
(unless key
(error "No key for the multisession object"))
@@ -69,6 +69,7 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
(symbol-name key)))))
(multisession--create
:key key
+ :synchronized synchronized
:initial-value initial-value
:package package))
@@ -91,21 +92,12 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
"create unique index multisession_idx on multisession (package,
key)")))))
(defun multisession-value (object)
- (catch 'done
- (while t
- (condition-case nil
- (throw 'done (multisession-value-1 object))
- (sqlite-locked-error
- (message "Sleeping...")
- (sleep-for 0.1))))))
-
-(defun multisession-value-1 (object)
"Return the value of the multisession OBJECT."
(if (or (null user-init-file)
(not (sqlite-available-p)))
;; If we don't have storage, then just return the value from the
;; object.
- (if (eq (multisession--cached-value object) :)
+ (if (markerp (multisession--cached-value object))
(multisession--initial-value object)
(multisession--cached-value object))
;; We have storage, so we update from storage.
@@ -114,7 +106,7 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
(symbol-name (multisession--key object)))))
(cond
;; We have no value yet; check the database.
- ((eq (multisession--cached-value object) :)
+ ((markerp (multisession--cached-value object))
(let ((stored
(car
(sqlite-select
@@ -150,12 +142,14 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
(defun multisession--set-value (object value)
(catch 'done
- (while t
- (condition-case nil
- (throw 'done (multisession--set-value-1 object value))
- (sqlite-locked-error
- (message "Sleeping...")
- (sleep-for 0.1))))))
+ (let ((i 0))
+ (while (< i 10)
+ (condition-case nil
+ (throw 'done (multisession--set-value-1 object value))
+ (sqlite-locked-error
+ (setq i (1+ i))
+ (sleep-for (+ 0.1 (/ (float (random 10)) 10))))))
+ (signal 'sqlite-locked-error "Database is locked"))))
(defun multisession--set-value-1 (object value)
(if (or (null user-init-file)
diff --git a/src/sqlite.c b/src/sqlite.c
index b1843bc..42e4abd 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -404,7 +404,9 @@ The number of affected rows is returned. */)
exit:
if (errmsg != NULL)
- xsignal1 (Qerror, build_string (errmsg));
+ xsignal1 (ret == SQLITE_LOCKED || ret == SQLITE_BUSY?
+ Qsqlite_locked_error: Qerror,
+ build_string (errmsg));
return retval;
}
@@ -700,8 +702,15 @@ syms_of_sqlite (void)
DEFSYM (Qfull, "full");
#endif
defsubr (&Ssqlitep);
- DEFSYM (Qsqlitep, "sqlitep");
defsubr (&Ssqlite_available_p);
+
+ DEFSYM (Qsqlite_locked_error, "sqlite-locked-error");
+ Fput (Qsqlite_locked_error, Qerror_conditions,
+ Fpurecopy (list2 (Qsqlite_locked_error, Qerror)));
+ Fput (Qsqlite_locked_error, Qerror_message,
+ build_pure_c_string ("Database locked"));
+
+ DEFSYM (Qsqlitep, "sqlitep");
DEFSYM (Qfalse, "false");
DEFSYM (Qsqlite, "sqlite");
DEFSYM (Qsqlite3, "sqlite3");
diff --git a/test/lisp/emacs-lisp/multisession-tests.el
b/test/lisp/emacs-lisp/multisession-tests.el
index 98c66e7..91037d5 100644
--- a/test/lisp/emacs-lisp/multisession-tests.el
+++ b/test/lisp/emacs-lisp/multisession-tests.el
@@ -26,13 +26,15 @@
(require 'ert-x)
(require 'cl-lib)
-(ert-deftest multi-test ()
+(ert-deftest multi-test-simple ()
(skip-unless (sqlite-available-p))
(let ((multisession-database-file (make-temp-name "/tmp/multi"))
(user-init-file "/tmp/foo.el"))
(unwind-protect
(progn
- (define-multisession-variable foo 0)
+ (define-multisession-variable foo 0
+ ""
+ :synchronized t)
(should (= (multisession-value foo) 0))
(cl-incf (multisession-value foo))
(should (= (multisession-value foo) 1))
@@ -46,7 +48,9 @@
(let ((multisession-database-file
,multisession-database-file)
(user-init-file "/tmp/foo.el"))
- (define-multisession-variable foo 0)
+ (define-multisession-variable foo 0
+ ""
+ :synchronized t)
(cl-incf (multisession-value foo))))))
(should (= (multisession-value foo) 2)))
(when (file-exists-p multisession-database-file)
@@ -54,7 +58,6 @@
(sqlite-close multisession--db)
(setq multisession--db nil)))))
-
(ert-deftest multi-test-busy ()
(skip-unless (sqlite-available-p))
(let ((multisession-database-file (make-temp-name "/tmp/multi"))
@@ -62,7 +65,9 @@
proc)
(unwind-protect
(progn
- (define-multisession-variable bar 0)
+ (define-multisession-variable bar 0
+ ""
+ :synchronized t)
(should (= (multisession-value bar) 0))
(cl-incf (multisession-value bar))
(should (= (multisession-value bar) 1))
@@ -78,14 +83,17 @@
(let ((multisession-database-file
,multisession-database-file)
(user-init-file "/tmp/bar.el"))
- (define-multisession-variable bar 0)
+ (define-multisession-variable bar 0
+ "" :synchronized t)
(dotimes (i 1000)
(cl-incf (multisession-value bar))))))))
(while (process-live-p proc)
- (message "bar is %s" (cl-incf (multisession-value bar)))
+ (ignore-error 'sqlite-locked-error
+ (cl-incf (multisession-value bar)))
+ (message "bar is %s" (multisession-value bar))
(sleep-for 0.1))
(message "bar ends up as %s" (multisession-value bar))
- (should (< (multisession-value bar) 2000)))
+ (should (< (multisession-value bar) 1002)))
(when (file-exists-p multisession-database-file)
(delete-file multisession-database-file)
(sqlite-close multisession--db)