emacs-elpa-diffs
[Top][All Lists]
Advanced

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

[nongnu] elpa/emacsql bb3dbfc891 213/427: Set a global query timeout.


From: ELPA Syncer
Subject: [nongnu] elpa/emacsql bb3dbfc891 213/427: Set a global query timeout.
Date: Tue, 13 Dec 2022 02:59:43 -0500 (EST)

branch: elpa/emacsql
commit bb3dbfc8914f8d9caad47a0a6b1fb978114f7ae0
Author: Christopher Wellons <wellons@nullprogram.com>
Commit: Christopher Wellons <wellons@nullprogram.com>

    Set a global query timeout.
---
 emacsql-compiler.el |  1 +
 emacsql.el          | 13 ++++++++++---
 2 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/emacsql-compiler.el b/emacsql-compiler.el
index 982e435922..9a7f8b57e6 100644
--- a/emacsql-compiler.el
+++ b/emacsql-compiler.el
@@ -22,6 +22,7 @@
 (emacsql-deferror emacsql-transaction () "Invalid transaction")
 (emacsql-deferror emacsql-fatal () "Fatal error")
 (emacsql-deferror emacsql-access () "Database access error")
+(emacsql-deferror emacsql-timeout () "Query timeout error")
 
 (defun emacsql-error (format &rest args)
   "Like `error', but signal an emacsql-syntax condition."
diff --git a/emacsql.el b/emacsql.el
index f3f426840f..44f9187d65 100644
--- a/emacsql.el
+++ b/emacsql.el
@@ -63,6 +63,10 @@
 (require 'finalize)
 (require 'emacsql-compiler)
 
+(defvar emacsql-global-timeout 30
+  "Maximum number of seconds to wait before bailing out on a SQL command.
+If nil, wait forever.")
+
 (defclass emacsql-connection ()
   ((process :type process
             :initarg :process
@@ -121,10 +125,13 @@ MESSAGE should not have a newline on the end."
 
 (defmethod emacsql-wait ((connection emacsql-connection) &optional timeout)
   "Block until CONNECTION is waiting for further input."
-  (let ((end (when timeout (+ (float-time) timeout))))
-    (while (and (or (null timeout) (< (float-time) end))
+  (let* ((real-timeout (or timeout emacsql-global-timeout))
+         (end (when real-timeout (+ (float-time) real-timeout))))
+    (while (and (or (null real-timeout) (< (float-time) end))
                 (not (emacsql-waiting-p connection)))
-      (accept-process-output (emacsql-process connection) timeout))))
+      (accept-process-output (emacsql-process connection) real-timeout))
+    (unless (emacsql-waiting-p connection)
+      (signal 'emacsql-timeout (list "Query timed out" real-timeout)))))
 
 (defgeneric emacsql-parse (connection)
   "Return the results of parsing the latest output or signal an error.")



reply via email to

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