Subject: bug#75789: [PATCH Debbugs] Factor cache accesses into dedicated functions

From: Morgan Smith <[email-masked]>
Date: Sun, 09 Feb 2025 21:01:30 -0500

Michael Albinus <[email-masked]> writes:

> Morgan Smith <[email-masked]> writes:
>
>> Hello!
>
> Hi Morgan,
>
Hi Michael,

Apologies for the delay.  I started a new job the day after I sent this
email!

>> 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.
>
> I don't know. See the comment you've removed as well:
>
> --8<---------------cut here---------------start------------->8---
>> -	  ;; Due to `debbugs-gnu-completion-table', this function
>> -	  ;; could be called in rapid sequence.  We cache temporarily
>> -	  ;; the value nil, therefore.
> --8<---------------cut here---------------end--------------->8---
>
> Have you checked that this doesn't happen without the temporary
> setting?

I'm honestly still not sure.  Maybe it's a simple test but I'm still
scared of completion tables from a bad experience a few years back.
I've just made some modifications so the same logic is in place.

>
> Some few comments:
>
>> 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)
>
> Oops. This is an existing bug. I will try to fix it later.
>

Thanks for fixing that!

>> +(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)
>
> This is wrong as-it-is. The extended definitions of debbugs-*-cache will
> persist after running the tests. A strict rule is, that all changes must
> be reverted after running the tests.

This is being violated in the current tests by the stubbing out of
`soap-invoke-internal'.  Please see the first attached patch where I fix
this.

> I don't believe you need this. Keep the (cl-letf (((symbol-function
> #'float-time) ...))) clause in debbugs-test-get-status, and do the same
> in debbugs-test-newest-bug-cached.

I wanted a clean wrapper around the cache functions to make it easy for
future testing.  Specifically, I want to add a feature so the cache
survives an emacs restart.

> Otherwise, it looks good to me. Please push to the debbugs repo; I'll
> play with it for a while before making a new release.

I don't believe I have push access to the repository.

> Thanks, and best regards, Michael.

Thanks for reviewing my patches!

Morgan

>From 5b0e08f4659ee871bca62987530ff13a88d3c4b5 Mon Sep 17 00:00:00 2001
From: Morgan Smith <[email-masked]>
Date: Sun, 9 Feb 2025 19:51:36 -0500
Subject: [PATCH 1/2] tests: Call new setup and teardown functions in tests

* test/debbugs-tests.el:
Create new functions `debbugs-test--setup' and `debbugs-test--teardown' to be
run before and after each test.

Create new macro `ert-deftest--debbugs' to automatically call the new
functions.

Adjust tests to use the new macro
---
 test/debbugs-tests.el | 91 ++++++++++++++++++++++++++-----------------
 1 file changed, 56 insertions(+), 35 deletions(-)

diff --git a/test/debbugs-tests.el b/test/debbugs-tests.el
index ce6489ca39..8402a4fff9 100644
--- a/test/debbugs-tests.el
+++ b/test/debbugs-tests.el
@@ -89,49 +89,70 @@
           nil)
       return)))
 
-(add-function
- :override (symbol-function #'soap-invoke-internal)
- #'debbugs-test--soap-invoke-internal)
+(defun debbugs-test--setup ()
+  "Mock network and time functions.
+These mock functions are needed to make the tests reproducible."
+  (setq debbugs-test--soap-operation-name nil)
+  (setq debbugs-test--soap-parameters nil)
+
+  (add-function
+   :override (symbol-function #'soap-invoke-internal)
+   #'debbugs-test--soap-invoke-internal))
+
+(defun debbugs-test--teardown ()
+  "Restore functions to as they where before."
+  (setq debbugs-test--soap-operation-name nil)
+  (setq debbugs-test--soap-parameters nil)
+
+  (remove-function
+   (symbol-function #'soap-invoke-internal)
+   #'debbugs-test--soap-invoke-internal))
+
+(defmacro ert-deftest--debbugs (name args docstring &rest body)
+  "The same as `ert-deftest' but runs setup and teardown functions."
+  (declare
+   (doc-string 3)
+   (indent 2))
+  `(ert-deftest ,name ,args ,docstring
+                (debbugs-test--setup)
+                ,@body
+                (debbugs-test--teardown)))
 
 ;;; Tests:
 
-(ert-deftest debbugs-test-get-bugs ()
+(ert-deftest--debbugs debbugs-test-get-bugs ()
   "Test \"get_bugs\"."
-  (let (debbugs-test--soap-operation-name debbugs-test--soap-parameters)
-    (debbugs-get-bugs
-     :tag "patch"
-     :severity "critical"
-     :status "open"
-     :status "forwarded")
-    (should (string-equal debbugs-test--soap-operation-name "get_bugs"))
-    (should (equal debbugs-test--soap-parameters
-                   '(["tag" "patch" "severity" "critical"
-                      "status" "open" "status" "forwarded"])))))
-
-(ert-deftest debbugs-test-newest-bugs ()
+  (debbugs-get-bugs
+   :tag "patch"
+   :severity "critical"
+   :status "open"
+   :status "forwarded")
+  (should (string-equal debbugs-test--soap-operation-name "get_bugs"))
+  (should (equal debbugs-test--soap-parameters
+                 '(["tag" "patch" "severity" "critical"
+                    "status" "open" "status" "forwarded"]))))
+
+(ert-deftest--debbugs debbugs-test-newest-bugs ()
   "Test \"newest_bugs\"."
-  (let (debbugs-test--soap-operation-name debbugs-test--soap-parameters)
-    (debbugs-newest-bugs 4)
-    (should (string-equal debbugs-test--soap-operation-name "newest_bugs"))
-    (should (equal debbugs-test--soap-parameters '(4)))))
+  (debbugs-newest-bugs 4)
+  (should (string-equal debbugs-test--soap-operation-name "newest_bugs"))
+  (should (equal debbugs-test--soap-parameters '(4))))
 
-(ert-deftest debbugs-test-get-status ()
+(ert-deftest--debbugs 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]))))))
-
-(ert-deftest debbugs-test-get-usertag ()
+  (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])))))
+
+(ert-deftest--debbugs debbugs-test-get-usertag ()
   "Test \"get_usertag\"."
-  (let (debbugs-test--soap-operation-name debbugs-test--soap-parameters)
-    (should (equal (debbugs-get-usertag :user "emacs") '("hi")))
-    (should (string-equal debbugs-test--soap-operation-name "get_usertag"))
-    (should (equal debbugs-test--soap-parameters '("emacs")))))
+  (should (equal (debbugs-get-usertag :user "emacs") '("hi")))
+  (should (string-equal debbugs-test--soap-operation-name "get_usertag"))
+  (should (equal debbugs-test--soap-parameters '("emacs"))))
 
 (provide 'debbugs-tests)
 
-- 
2.48.1

>From 7bc3aa8a32a0185400423504a15368b3865d1ca3 Mon Sep 17 00:00:00 2001
From: Morgan Smith <[email-masked]>
Date: Wed, 22 Jan 2025 18:19:13 -0500
Subject: [PATCH 2/2] Factor cache accesses into dedicated functions

* 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.
---
 debbugs.el            | 107 ++++++++++++++++++++++--------------------
 test/debbugs-tests.el |  57 ++++++++++++++++++----
 2 files changed, 103 insertions(+), 61 deletions(-)

diff --git a/debbugs.el b/debbugs.el
index 5ab1dfc4ba..dd9b6dc09f 100644
--- a/debbugs.el
+++ b/debbugs.el
@@ -118,6 +118,33 @@ 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 &optional ttl)
+  "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))))
+      (let ((cache-time (float-time)))
+        ;; Kind of a hack for TTL that assume that `debbugs-cache-expiry'
+        ;; doesn't change
+        (when (and ttl (natnump debbugs-cache-expiry))
+          (setq cache-time (+ ttl (- cache-time debbugs-cache-expiry))))
+        (puthash bug-number
+                 (cons (cons 'cache_time cache-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,41 +352,29 @@ 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))
-	  ;; 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)))))
-
-	  ;; Cache it.
-	  (when (or (null debbugs-cache-expiry) (natnump debbugs-cache-expiry))
-	    (puthash 0 status debbugs-cache-data)))
-
-	;; Return the value, as list.
-	(list (alist-get 'newest_bug status)))
+      ;; We cache it as bug "0"
+      (let ((status (debbugs-get-cache 0)))
+        (unless status
+          ;; 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)
+            (debbugs-put-cache 0 (list 'newest_bug) 1))
+
+          ;; Compute the value.
+          (setq
+           status
+           (list
+            (cons 'newest_bug
+                  (caar
+                   (debbugs-soap-invoke
+                    debbugs-wsdl debbugs-port "newest_bugs" amount)))))
+
+          ;; Cache it.
+          (debbugs-put-cache 0 status))
+
+        ;; Return the value, as list.
+        (list (alist-get 'newest_bug status)))
 
     (sort
      (car (debbugs-soap-invoke
@@ -477,15 +492,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 +590,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 8402a4fff9..f3abea2837 100644
--- a/test/debbugs-tests.el
+++ b/test/debbugs-tests.el
@@ -89,6 +89,12 @@
           nil)
       return)))
 
+(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)))
+
 (defun debbugs-test--setup ()
   "Mock network and time functions.
 These mock functions are needed to make the tests reproducible."
@@ -97,7 +103,15 @@ These mock functions are needed to make the tests reproducible."
 
   (add-function
    :override (symbol-function #'soap-invoke-internal)
-   #'debbugs-test--soap-invoke-internal))
+   #'debbugs-test--soap-invoke-internal)
+
+  (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))
 
 (defun debbugs-test--teardown ()
   "Restore functions to as they where before."
@@ -106,7 +120,15 @@ These mock functions are needed to make the tests reproducible."
 
   (remove-function
    (symbol-function #'soap-invoke-internal)
-   #'debbugs-test--soap-invoke-internal))
+   #'debbugs-test--soap-invoke-internal)
+
+  (remove-function
+   (symbol-function #'debbugs-get-cache)
+   #'debbugs-test--override-float-time)
+
+  (remove-function
+   (symbol-function #'debbugs-put-cache)
+   #'debbugs-test--override-float-time))
 
 (defmacro ert-deftest--debbugs (name args docstring &rest body)
   "The same as `ert-deftest' but runs setup and teardown functions."
@@ -138,15 +160,32 @@ These mock functions are needed to make the tests reproducible."
   (should (string-equal debbugs-test--soap-operation-name "newest_bugs"))
   (should (equal debbugs-test--soap-parameters '(4))))
 
+(ert-deftest--debbugs debbugs-test-newest-bug-cached ()
+  "Test getting the newest bug from the cache."
+  ;; 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 debbugs-test-get-status ()
   "Test \"get_status\"."
-  (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 debbugs-test-get-usertag ()
   "Test \"get_usertag\"."
-- 
2.48.1