emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

scratch/sqlite b01c83d 1/2: Start thinking about handling contended tabl


From: Lars Ingebrigtsen
Subject: scratch/sqlite b01c83d 1/2: Start thinking about handling contended tables
Date: Sun, 12 Dec 2021 23:39:38 -0500 (EST)

branch: scratch/sqlite
commit b01c83d453e65fee1c41fd4d97fb220a31ab33ff
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Start thinking about handling contended tables
---
 lisp/emacs-lisp/multisession.el            | 46 +++++++++++++++++++++---------
 test/lisp/emacs-lisp/multisession-tests.el | 41 +++++++++++++++++++++++++-
 2 files changed, 73 insertions(+), 14 deletions(-)

diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index a519d3c..96617e2 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -27,6 +27,8 @@
 (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."
@@ -74,21 +76,30 @@ DOC should be a doc string, and ARGS are keywords as 
applicable to
 
 (defun multisession--ensure-db ()
   (unless multisession--db
-    (setq multisession--db (sqlite-open multisession-database-file)))
-  (with-sqlite-transaction multisession--db
-    (unless (sqlite-select
-             multisession--db
-             "select name from sqlite_master where type='table' and 
name='multisession'")
-      ;; Create the table.
-      (sqlite-execute multisession--db "PRAGMA auto_vacuum = FULL")
-      (sqlite-execute
-       multisession--db
-       "create table multisession (package text not null, key text not null, 
sequence number not null default 1, value text not null)")
-      (sqlite-execute
-       multisession--db
-       "create unique index multisession_idx on multisession (package, 
key)"))))
+    (setq multisession--db (sqlite-open multisession-database-file))
+    (with-sqlite-transaction multisession--db
+      (unless (sqlite-select
+               multisession--db
+               "select name from sqlite_master where type = 'table' and name = 
'multisession'")
+        ;; Create the table.
+        (sqlite-execute multisession--db "PRAGMA auto_vacuum = FULL")
+        (sqlite-execute
+         multisession--db
+         "create table multisession (package text not null, key text not null, 
sequence number not null default 1, value text not null)")
+        (sqlite-execute
+         multisession--db
+         "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)))
@@ -138,6 +149,15 @@ DOC should be a doc string, and ARGS are keywords as 
applicable to
         (multisession--cached-value object))))))
 
 (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))))))
+
+(defun multisession--set-value-1 (object value)
   (if (or (null user-init-file)
           (not (sqlite-available-p)))
       ;; We have no backend, so just store the value.
diff --git a/test/lisp/emacs-lisp/multisession-tests.el 
b/test/lisp/emacs-lisp/multisession-tests.el
index 521f898..98c66e7 100644
--- a/test/lisp/emacs-lisp/multisession-tests.el
+++ b/test/lisp/emacs-lisp/multisession-tests.el
@@ -50,6 +50,45 @@
                           (cl-incf (multisession-value foo))))))
           (should (= (multisession-value foo) 2)))
       (when (file-exists-p multisession-database-file)
-        (delete-file multisession-database-file)))))
+        (delete-file multisession-database-file)
+        (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"))
+        (user-init-file "/tmp/bar.el")
+        proc)
+    (unwind-protect
+        (progn
+          (define-multisession-variable bar 0)
+          (should (= (multisession-value bar) 0))
+          (cl-incf (multisession-value bar))
+          (should (= (multisession-value bar) 1))
+          (setq proc
+                (start-process
+                 "other-emacs"
+                 nil
+                 (concat invocation-directory invocation-name)
+                 "-Q" "-batch"
+                 "--eval" (prin1-to-string
+                           `(progn
+                              (require 'multisession)
+                              (let ((multisession-database-file
+                                     ,multisession-database-file)
+                                    (user-init-file "/tmp/bar.el"))
+                                (define-multisession-variable bar 0)
+                                (dotimes (i 1000)
+                                  (cl-incf (multisession-value bar))))))))
+          (while (process-live-p proc)
+            (message "bar is %s" (cl-incf (multisession-value bar)))
+            (sleep-for 0.1))
+          (message "bar ends up as %s" (multisession-value bar))
+          (should (< (multisession-value bar) 2000)))
+      (when (file-exists-p multisession-database-file)
+        (delete-file multisession-database-file)
+        (sqlite-close multisession--db)
+        (setq multisession--db nil)))))
 
 ;;; multisession-tests.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]