Fix 'with-sqlite-transaction' when BODY fails

* lisp/sqlite.el (with-sqlite-transaction): Don't commit changes
if BODY errors out.  Roll back the transaction if committing
fails.  (Bug#67142)

* etc/NEWS:
* doc/lispref/text.texi (Database): Document the error handling in
'with-sqlite-transaction'.

3 files changed, 25 insertions, 7 deletions

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 4f11caaf64e..8fa2100ba11 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5486,7 +5486,11 @@ made by the transaction.
 
 @defmac with-sqlite-transaction db body@dots{}
 Like @code{progn} (@pxref{Sequencing}), but executes @var{body} with a
-transaction held, and commits the transaction at the end.
+transaction held, and commits the transaction at the end if @var{body}
+completes normally.  If @var{body} signals an error, or committing the
+transaction fails, the changes in @var{db} performed by @var{body} are
+rolled back.  The macro returns the value of @var{body} if it
+completes normally and commit succeeds.
 @end defmac
 
 @defun sqlite-pragma db pragma
diff --git a/etc/NEWS b/etc/NEWS
index 1b3532b5657..333699f1015 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -62,6 +62,11 @@ of showing the shortcuts.
 
 * Incompatible Lisp Changes in Emacs 29.2
 
++++
+** 'with-sqlite-transaction' rolls back changes if its BODY fails.
+If the BODY of the macro signals an error, or committing the results
+of the transaction fails, the changes will now be rolled back.
+
 
 * Lisp Changes in Emacs 29.2
 
diff --git a/lisp/sqlite.el b/lisp/sqlite.el
index aad0aa40fa4..8a525739c9a 100644
--- a/lisp/sqlite.el
+++ b/lisp/sqlite.el
@@ -24,19 +24,28 @@
 ;;; Code:
 
 (defmacro with-sqlite-transaction (db &rest body)
-  "Execute BODY while holding a transaction for DB."
+  "Execute BODY while holding a transaction for DB.
+If BODY completes normally, commit the changes and return
+the value of BODY.
+If BODY signals an error, or transaction commit fails, roll
+back the transaction changes."
   (declare (indent 1) (debug (form body)))
   (let ((db-var (gensym))
-        (func-var (gensym)))
+        (func-var (gensym))
+        (res-var (gensym))
+        (commit-var (gensym)))
     `(let ((,db-var ,db)
-           (,func-var (lambda () ,@body)))
+           (,func-var (lambda () ,@body))
+           ,res-var ,commit-var)
        (if (sqlite-available-p)
            (unwind-protect
                (progn
                  (sqlite-transaction ,db-var)
-                 (funcall ,func-var))
-             (sqlite-commit ,db-var))
-         (funcall ,func-var)))))
+                 (setq ,res-var (funcall ,func-var))
+                 (setq ,commit-var (sqlite-commit ,db-var))
+                 ,res-var)
+             (or ,commit-var (sqlite-rollback ,db-var))))
+         (funcall ,func-var))))
 
 (provide 'sqlite)