Package: emacs;
Reported by: Morgan Smith <Morgan.J.Smith <at> outlook.com>
Date: Thu, 23 Jan 2025 18:35:01 UTC
Severity: wishlist
Tags: patch
Fixed in version 31.1
Done: Michael Albinus <michael.albinus <at> gmx.de>
Bug is archived. No further changes may be made.
Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Morgan Smith <Morgan.J.Smith <at> outlook.com> To: bug-gnu-emacs <at> gnu.org Cc: Morgan Smith <Morgan.J.Smith <at> outlook.com> Subject: [PATCH Debbugs] Factor cache accesses into dedicated functions Date: Thu, 23 Jan 2025 13:22:18 -0500
* debbugs.el (debbugs-get-cache, debbugs-put-cache): New functions.
(debbugs-newest-bugs, debbugs-get-status): Use new functions.
* test/debbugs-tests.el: Use advice to set the `cache_time' around the new
functions.
(debbugs-test-newest-bug-cached): New test.
(debbugs-test-get-status): Add test for caching behavior.
---
Hello!
Just a little bit of code cleanup. I hope this is helpful.
You'll notice I removed a bit in `debbugs-newest-bugs' that was supposed to
temporarily generate a null value. I'm not entirely certain but I don't
believe that actually does anything right? Immediately after that we make a
synchronous soap call anyways and then return that value.
debbugs.el | 80 +++++++++++++++++++------------------------
test/debbugs-tests.el | 50 +++++++++++++++++++++++----
2 files changed, 79 insertions(+), 51 deletions(-)
diff --git a/debbugs.el b/debbugs.el
index 5ab1dfc4ba..36fdca8ff0 100644
--- a/debbugs.el
+++ b/debbugs.el
@@ -118,6 +118,28 @@ t or 0 disables caching, nil disables expiring."
(const :tag "Forever" nil)
(integer :tag "Seconds")))
+(defun debbugs-get-cache (bug-number)
+ "Return the cached status entry for the bug identified by BUG-NUMBER."
+ (let ((status (gethash bug-number debbugs-cache-data)))
+ (when (and status
+ (or (null debbugs-cache-expiry)
+ (and
+ (natnump debbugs-cache-expiry)
+ (> (alist-get 'cache_time status)
+ (- (float-time) debbugs-cache-expiry)))))
+ status)))
+
+(defun debbugs-put-cache (bug-number status)
+ "Put the STATUS entry for the bug BUG-NUMBER in the cache.
+Return STATUS."
+ (if (or (null debbugs-cache-expiry)
+ (and (natnump debbugs-cache-expiry)
+ (not (zerop debbugs-cache-expiry))))
+ (puthash bug-number
+ (cons (cons 'cache_time (float-time)) status)
+ debbugs-cache-data)
+ status))
+
(defun debbugs-soap-invoke (operation-name &rest parameters)
"Invoke the SOAP connection.
OPERATION-NAME and PARAMETERS are as described in `soap-invoke'."
@@ -325,38 +347,20 @@ patch:
(defun debbugs-newest-bugs (amount)
"Return the list of bug numbers, according to AMOUNT (a number) latest bugs."
(if (= amount 1)
- ;; We cache it as bug "0" in `debbugs-cache-data'.
- (let ((status (gethash 0 debbugs-cache-data)))
- (unless (and
- status
- (or
- (null debbugs-cache-expiry)
- (and
- (natnump debbugs-cache-expiry)
- (> (alist-get 'cache_time status)
- (- (float-time) debbugs-cache-expiry)))))
- ;; Due to `debbugs-gnu-completion-table', this function
- ;; could be called in rapid sequence. We cache temporarily
- ;; the value nil, therefore.
- (when (natnump debbugs-cache-expiry)
- (puthash
- 0
- (list (cons 'cache_time (1+ (- (float-time) debbugs-cache-expiry)))
- (list 'newest_bug))
- debbugs-cache-data))
+ ;; We cache it as bug "0"
+ (let ((status (debbugs-get-cache 0)))
+ (unless status
;; Compute the value.
(setq
status
- (list
- (cons 'cache_time (float-time))
- (cons 'newest_bug
- (caar
- (debbugs-soap-invoke
- debbugs-wsdl debbugs-port "newest_bugs" amount)))))
+ (list
+ (cons 'newest_bug
+ (caar
+ (debbugs-soap-invoke
+ debbugs-wsdl debbugs-port "newest_bugs" amount)))))
;; Cache it.
- (when (or (null debbugs-cache-expiry) (natnump debbugs-cache-expiry))
- (puthash 0 status debbugs-cache-data)))
+ (debbugs-put-cache 0 status))
;; Return the value, as list.
(list (alist-get 'newest_bug status)))
@@ -477,15 +481,8 @@ Example:
(delq nil
(mapcar
(lambda (bug)
- (let ((status (gethash bug debbugs-cache-data)))
- (if (and
- status
- (or
- (null debbugs-cache-expiry)
- (and
- (natnump debbugs-cache-expiry)
- (> (alist-get 'cache_time status)
- (- (float-time) debbugs-cache-expiry)))))
+ (let ((status (debbugs-get-cache bug)))
+ (if status
(progn
(setq cached-bugs (append cached-bugs (list status)))
nil)
@@ -582,14 +579,9 @@ Example:
(when (stringp (cdr y))
(setcdr y (split-string (cdr y) ",\\| " t))))
;; Cache the result, and return.
- (if (or (null debbugs-cache-expiry) (natnump debbugs-cache-expiry))
- (puthash
- (alist-get 'key x)
- ;; Put also a time stamp.
- (cons (cons 'cache_time (float-time)) (alist-get 'value x))
- debbugs-cache-data)
- ;; Don't cache.
- (alist-get 'value x))))
+ (debbugs-put-cache
+ (alist-get 'key x)
+ (alist-get 'value x))))
debbugs-soap-invoke-async-object))))
(defun debbugs-get-usertag (&rest query)
diff --git a/test/debbugs-tests.el b/test/debbugs-tests.el
index ce6489ca39..d0aa9e87b4 100644
--- a/test/debbugs-tests.el
+++ b/test/debbugs-tests.el
@@ -28,6 +28,10 @@
(require 'debbugs)
+;; TODO: This shouldn't be necessary but I get the error
+;; "(void-variable debbugs-gnu-use-threads)" without this
+(require 'debbugs-gnu)
+
;;; Helper Data:
;; Generated using this:
@@ -93,6 +97,20 @@
:override (symbol-function #'soap-invoke-internal)
#'debbugs-test--soap-invoke-internal)
+(defun debbugs-test--override-float-time (func &rest rest)
+ "Override `float-time' for FUNC with args REST."
+ (cl-letf (((symbol-function #'float-time)
+ (lambda (&optional _specified-time) 5000)))
+ (apply func rest)))
+
+(add-function
+ :around (symbol-function #'debbugs-get-cache)
+ #'debbugs-test--override-float-time)
+
+(add-function
+ :around (symbol-function #'debbugs-put-cache)
+ #'debbugs-test--override-float-time)
+
;;; Tests:
(ert-deftest debbugs-test-get-bugs ()
@@ -115,16 +133,34 @@
(should (string-equal debbugs-test--soap-operation-name "newest_bugs"))
(should (equal debbugs-test--soap-parameters '(4)))))
+(ert-deftest debbugs-test-newest-bug-cached ()
+ "Test getting the newest bug from the cache."
+ (let (debbugs-test--soap-operation-name debbugs-test--soap-parameters)
+ ;; First time we get it from the server.
+ (should (equal (debbugs-newest-bugs 1) '(0)))
+ (should (equal debbugs-test--soap-operation-name "newest_bugs"))
+ (should (equal debbugs-test--soap-parameters '(1)))
+ (setq debbugs-test--soap-operation-name nil)
+ (setq debbugs-test--soap-parameters nil)
+ ;; Now it's cached
+ (should (equal (debbugs-newest-bugs 1) '(0)))
+ (should (equal debbugs-test--soap-operation-name nil))
+ (should (equal debbugs-test--soap-parameters nil))))
+
(ert-deftest debbugs-test-get-status ()
"Test \"get_status\"."
(let (debbugs-test--soap-operation-name debbugs-test--soap-parameters)
- (cl-letf (((symbol-function #'float-time)
- (lambda (&optional _specified-time) 5000)))
- (should (= (float-time) 5000))
- (should (equal (sort (car (debbugs-get-status 64064)))
- (sort (car debbugs-test--bug-status))))
- (should (string-equal debbugs-test--soap-operation-name "get_status"))
- (should (equal debbugs-test--soap-parameters '([64064]))))))
+ (should (equal (sort (car (debbugs-get-status 64064)))
+ (sort (car debbugs-test--bug-status))))
+ (should (string-equal debbugs-test--soap-operation-name "get_status"))
+ (should (equal debbugs-test--soap-parameters '([64064])))
+ (setq debbugs-test--soap-operation-name nil)
+ (setq debbugs-test--soap-parameters nil)
+ ;; cached
+ (should (equal (sort (car (debbugs-get-status 64064)))
+ (sort (car debbugs-test--bug-status))))
+ (should (equal debbugs-test--soap-operation-name nil))
+ (should (equal debbugs-test--soap-parameters nil))))
(ert-deftest debbugs-test-get-usertag ()
"Test \"get_usertag\"."
--
2.47.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.